Sub OnClick(ByVal Item)
Dim ors,conn,con,ssql,ocom
Dim ors1,conn1,con1,ssql1,ocom1
Dim ssql2,ocom2
Dim ocatalog,otable
Dim i,TableExist
Dim PCName
PCName=HMIRuntime.Tags("@LocalMachineName").Read
con="Provider = SQLOLEDB.1;password = sa;user id = sa;Initial Catalog =master;Data Source = " & PCName & "\WINCC"
Set conn=CreateObject("ADODB.Connection")
conn.ConnectionString=con
conn.Cursorlocation=3
conn.open
ssql="select * from master.dbo.sysdatabases where [name] ='MyDataBase'"
Set ors=CreateObject("ADODB.RecordSet")
Set ocom=CreateObject("ADODB.Command")
Set ocom.activeconnection=conn
ocom.CommandType=1
ocom.CommandText=ssql
Set ors=ocom.Execute
If ors.recordcount>0 Then
con1="Provider = SQLOLEDB.1;password = sa;user id = sa;Initial Catalog =Mydatabase;Data Source = " & PCName & "\WINCC"
Set conn1=CreateObject("ADODB.Connection")
conn1.ConnectionString=con1
conn1.Cursorlocation=3
conn1.open
ssql="select name from SYSOBJECTS where type ='U'"
Set ors1=CreateObject("ADODB.RecordSet")
Set ocom1=CreateObject("ADODB.Command")
Set ocom1.activeconnection=conn1
ocom1.CommandType=1
ocom1.CommandText=ssql
Set ors1=ocom1.Execute
If ors1.recordcount>0 Then
ors1.movefirst
For i=1 To ors1.recordcount
If UCase(ors1.fields("name").value)=Ucase("mytable") Then '大小写敏感
TableExist=True
Exit For
Else
ors1.movenext
End If
Next
Else
TableExist=False
End If
If TableExist Then
Msgbox "表已经存在,无需创建"
Else
ssql2="create table Mytable(CurIndex int identity(1,1) primary key,stuNo char(6) not null,Age int not null)"
Set ocom2=CreateObject("ADODB.Command")
Set ocom2.activeconnection=conn1
ocom2.CommandText=ssql2
Set ors1=ocom2.Execute
Msgbox "表创建完毕"
End if
Else
Msgbox "数据库不存在,请先创建数据库"
End If
Set ors=Nothing
conn.close
Set conn=Nothing
Set ors1=Nothing
conn1.close
Set conn1=Nothing
End Sub