求救，急，请帮帮忙，怎么在VB中用代码实现创建一个新的数据库，再再数据库中创建新的表，并向表中添加数据？？

Question

题目太长了，主要是实现数据库结构的自动恢复，如果数据库中不存在特定的库YHERP，就创建一个大小为100M的数据库，保存在应用程序目录下
然后检测两张表是否存在，不在就创建两张表Eemp和Econtract，并建立表间关系，
想了半天不懂怎么创建库和表，以前只会连接数据库和表
请大家帮帮忙，如果做过这个的，救救我！！！

Answer 1

Private Sub Form_Load()
'菜单“工程”-->"引用"-->"Microsoft ActiveX Data Objects 2.7 Library"
'Microsoft ADO Ext.2.7 for DDL ado Security
 Dim cat As ADOX.Catalog
 Set cat = New ADOX.Catalog
cat.Create ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + App.Path & "\newdata.mdb" + ";")
MsgBox "数据库已经创建成功！"
Dim tbl As ADOX.Table
Set tbl = New ADOX.Table
tbl.ParentCatalog = cat
tbl.Name = "MyTable"'增加一个自动增长的字段
Dim col As ADOX.Column
Set col = New ADOX.Column
col.ParentCatalog = cat
col.Type = ADOX.DataTypeEnum.adInteger ' // 必须先设置字段类型
col.Name = "id"
col.Properties("Jet OLEDB:Allow Zero Length").Value = False
col.Properties("AutoIncrement").Value = True
tbl.Columns.Append col, ADOX.DataTypeEnum.adInteger, 0'增加一个文本字段
Dim col2 As ADOX.Column
Set col2 = New ADOX.Column
col2.ParentCatalog = cat
col2.Name = "Description"
col2.Properties("Jet OLEDB:Allow Zero Length").Value = False
tbl.Columns.Append col2, ADOX.DataTypeEnum.adVarChar, 25'增加一个货币型字段
Dim col4 As ADOX.Column
Set col4 = New ADOX.Column
col4.ParentCatalog = cat
col4.Type = ADOX.DataTypeEnum.adCurrency
col4.Name = "xx"
tbl.Columns.Append col4, ADOX.DataTypeEnum.adCurrency'增加一个OLE字段
Dim col5 As ADOX.Column
Set col5 = New ADOX.Column
col5.ParentCatalog = cat
col5.Type = ADOX.DataTypeEnum.adLongVarBinary
col5.Name = "OLD_FLD"
tbl.Columns.Append col5, ADOX.DataTypeEnum.adLongVarBinary'增加一个数值型字段
Dim col3 As ADOX.Column
Set col3 = New ADOX.Column
col3.ParentCatalog = cat
col3.Type = ADOX.DataTypeEnum.adDouble
col3.Name = "ll"
tbl.Columns.Append col3, ADOX.DataTypeEnum.adDouble
Dim p As ADOX.Property
For Each p In col3.Properties
    Debug.Print p.Name & ":" & p.Value & ":" & p.Type & ":" & p.Attributes
Next'设置主键
tbl.Keys.Append "PrimaryKey", ADOX.KeyTypeEnum.adKeyPrimary, "id", "", ""
cat.Tables.Append tbl
MsgBox "数据库表：" + tbl.Name + "已经创建成功！"
Set tbl = Nothing
Set cat = NothingDim adocon As ADODB.Connection
Set adocon = New ADODB.Connection
Dim Rs As New ADODB.Recordset
adocon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\newdata.mdb;" & "Mode=Share Deny Read|Share Deny Write;Persist Security Info=False;Jet OLEDB:Database Password="
Dim strTable As String
strTable = "myTable"
'Set Rs = adocon.OpenSchema(adSchemaColumns, TABLE_NAME)
Set Rs = adocon.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTable, Empty))
Do Until Rs.EOF
      Debug.Print "Table name: " & _
         Rs!TABLE_NAME & vbCr & _
         "Table type: " & Rs!TABLE_TYPE & vbCr
      Rs.MoveNext
   Loop
Rs.Close
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = adocon
For i = 0 To cat.Tables.Count - 1
   Debug.Print cat.Tables(i).Name   '取出表名
   If cat.Tables(i).Name = "MyTable" Then
   For j = 0 To cat.Tables(i).Columns.Count - 1
      Debug.Print cat.Tables(i).Columns(j)    '取出列名
      Debug.Print cat.Tables(i).Columns(j).Type '取出数据类型
      For Each p In cat.Tables(i).Columns(j).Properties
      Debug.Print p.Type & p.Name & p.Attributes    '取出列的属性
      Next
   Next j
   
   End If
Next icat.Tables.Item("MyTable").Columns("ll").Properties("Jet OLEDB:Allow Zero Length").Value = True '设置零长度正确
'For i = 0 To cat.Tables.Count - 1                        '修改表名，暂不行，测试没通过
'   If cat.Tables(i).Name = "MyTable" Then
'    cat.Tables.Item(1).Name = "NewMyTable"
'   End If
'Next i
Set cat = Nothing
adocon.Close
Set adocon = Nothing
End Sub

Answer 2

'''''判断某表中某字段是否存在
Public Function SQLExistTable(cn As Connection, strTable As String, strfield As String) As Boolean
Dim strSQL As String
Dim Rs As New ADODB.Recordset
'Dim dbname As String
Dim bTemp As BooleanOn Error GoTo errSQLExist
'strSQL = "select counttable=count(*) from temp where name='" & strTable & "'"
'rs.Open strSQL, cn
'Set Rs = cn.OpenSchema(adSchemaTables)
   Set Rs = cn.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTable, Empty))Do Until Rs.EOF
If Rs!column_name = strfield Then
   bTemp = True
   Exit Do
Else
   bTemp = False
End If
Rs.MoveNext
Loop
SQLExistTable = bTempExit FunctionerrSQLExist:
            SQLExistTable = False
            Exit Function
End Function注：
   Set Rs = cn.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTable, Empty))
其中的adSchemaColumns改成adSchemaTables,strtable改成数据库名，即为判断表存不存在

Answer 3

十分感谢,不过,我需要使用代码来在SQL Server 中建立一个数据库,上面建立数据库的代码是Access的,怎么建一个SQL数据库呢?高手

Answer 4

'创建数据库（名称为NewDbName）的代码
strSQL = "USE master "& vbCrLf
strSQL=strSQL &"CREATE DATABASE NewDbName "        
cnn.Execute strSQL'创建一个名为TDataClearLog的表的部分代码
isExist = False
    If sfCheckTblIsExist("TDataClearLog", isExist) = False Then Exit Function
    
    If isExist = False Then
        strSQL = strSQL & "CREATE TABLE [TDataClearLog] (" & vbCrLf
        strSQL = strSQL & "    [ClearID] [int] IDENTITY (1, 1) NOT NULL ," & vbCrLf
        strSQL = strSQL & "    [UserID] [varchar] (12) COLLATE Chinese_PRC_CI_AS NOT NULL ," & vbCrLf
        strSQL = strSQL & "    [ShopID] [varchar] (20) COLLATE Chinese_PRC_CI_AS NOT NULL ," & vbCrLf
        strSQL = strSQL & "    [StartDate] [smalldatetime] NOT NULL ," & vbCrLf
        strSQL = strSQL & "    [EndDate] [smalldatetime] NOT NULL ," & vbCrLf
        strSQL = strSQL & "    [ExecDate] [datetime] NOT NULL CONSTRAINT [DF__TDataClea__ExecD__308674FD] DEFAULT (getdate())," & vbCrLf
        strSQL = strSQL & "    [DataID] [int] NOT NULL ," & vbCrLf
        strSQL = strSQL & "    CONSTRAINT [PK_TDATACLEARLOG] PRIMARY KEY  CLUSTERED" & vbCrLf
        strSQL = strSQL & "    (" & vbCrLf
        strSQL = strSQL & "        [ClearID]" & vbCrLf
        strSQL = strSQL & "    )  ON [PRIMARY]" & vbCrLf
        strSQL = strSQL & ") ON [PRIMARY] " & vbCrLf
        strSQL = strSQL & "  " & vbCrLf
    End If
    
    If strSQL <> "" Then
        cnn.BeginTrans
        cnn.Execute strSQL
        cnn.CommitTrans
    End If'检查表是否已经存在的函数
Private Function sfCheckTblIsExist(strTblName As String, _
                                    Optional isExist As Boolean = False) As Boolean
    On Error GoTo errHandle
    Dim strSQL As String
    Dim RsTmp As New Recordset
    sfCheckTblIsExist = True
    
    Set RsTmp = cnn.OpenSchema(adSchemaTables, Array(Empty, Empty, strTblName, Empty))
    
    If Not RsTmp.EOF Then
        isExist = True
    End If
    
    Exit Function
errHandle:
    sfCheckTblIsExist = False
    msgbox "创建数据表时出现意外：" & vbCrLf & Err.Description
End Function