Public Sub Create_DATA(IP As String, uid As String, pwd As String, dataname As String)
'-----------------------创建数据库--------------------------------
'ip服务器IP地址
'uid SQL用户名
'pwd SQL密码
'在IP上创建名字为dataname的数据库
'-----------------------------------------------------------
Dim con1 As ADODB.Connection
Dim test As String
Dim connectstring As String
On Error GoTo errc
Set con1 = New ADODB.Connection
'connectstring = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=Northwind;Data Source=."
connectstring = "Driver=SQL Server;Server=" & IP & ";UID=" & uid & ";PWD=" & pwd & ";Database=Northwind"
con1.Open connectstring
test = "if exists (select * from sysobjects where id = object_id(N'[dbo].[" & dataname & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) DROP DATABASE " & dataname
con1.Execute ("if exists (select * from sysobjects where id = object_id(N'[dbo].[" & dataname & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) DROP DATABASE " & dataname)
DoEvents
con1.Execute ("create database " & dataname)
con1.Close
Exit Sub
errc:
MsgBox Error(Err.Number), vbOKOnly + vbInformation, "提示"
End Sub
'-----------------------创建数据库--------------------------------
'ip服务器IP地址
'uid SQL用户名
'pwd SQL密码
'在IP上创建名字为dataname的数据库
'-----------------------------------------------------------
Dim con1 As ADODB.Connection
Dim test As String
Dim connectstring As String
On Error GoTo errc
Set con1 = New ADODB.Connection
'connectstring = "Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=Northwind;Data Source=."
connectstring = "Driver=SQL Server;Server=" & IP & ";UID=" & uid & ";PWD=" & pwd & ";Database=Northwind"
con1.Open connectstring
test = "if exists (select * from sysobjects where id = object_id(N'[dbo].[" & dataname & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) DROP DATABASE " & dataname
con1.Execute ("if exists (select * from sysobjects where id = object_id(N'[dbo].[" & dataname & "]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) DROP DATABASE " & dataname)
DoEvents
con1.Execute ("create database " & dataname)
con1.Close
Exit Sub
errc:
MsgBox Error(Err.Number), vbOKOnly + vbInformation, "提示"
End Sub