.mdb.access数据库VBA-利用工作表数据创建数据表（ADOX）

时间：2025-01-20 08:52:55 来源：作者：

利用工作表数据创建数据表（ADOX）

引用：microsoft ado ext.2.x for ddl and security

代码：
Public Sub1_10()
    Dim myCat As New ADOX.Catalog   ‘定义catalog变量
    Dim myTable As New ADOX.Table   ‘定义table变量
    Dim myColumn As ADOX.Column   ‘定义column变量
    Dim myIdx   As New ADOX.Index  ‘定义index变量
    Dim ws As Worksheet              ‘定义worksheet变量
    Dim i As Long
    Dim myData As String              ‘
    myData = ThisWorkbook.Path & "\学生成绩管理.mdb"   ‘指定数据文件
    ‘判断是否有保存数据表资料的工作表存在
On Error Resume Next
    Set ws = Worksheets("数据表设计")
    On Error GoTo 0
    If ws Is Nothing Then
        MsgBox "没有数据表资料存在！", vbCritical, "警告"
        Exit Sub
    End If
    ws.Activate
    ‘建立与数据库的连接
    myCat.ActiveConnection = "provider=microsoft.jet.oledb.4.0;" _
        & " data source=" & myData
    ‘删除已经存在的数据表
    On Error Resume Next
    myCat.Tables.Delete ws.Range("B1").Value
    On Error GoTo 0
    ‘建立索引
    myIdx.Name = "PrimaryKey"
    myIdx.PrimaryKey = True
    ‘开始根据工作表的数据创建数据表
    With myTable
        .Name = ws.Range("B1").Value
        For i = 4 To ws.Range("A65536").End(xlUp).Row
            Set myColumn = New Column
            With myColumn
                .Name = ws.Cells(i, 1).Value
                .Type = GetConstNo(ws.Cells(i, 2).Value)
                If ws.Cells(i, 3).Value > 0 Then
                    .DefinedSize = ws.Cells(i, 3).Value
                    .Attributes = adColNullable
                End If
            End With
            .Columns.Append myColumn
            If ws.Cells(i, 4).Value = "是" Then
                myIdx.Columns.Append ws.Cells(i, 1).Value
            End If
        Next
    End With
    ‘将表定义进行保存
    myCat.Tables.Append myTable
    myTable.Indexes.Append myIdx
    ‘弹出信息
MsgBox "数据表<" & ws.Range("B1").Value & ">创建成功！", _
        vbOKOnly + vbInformation, "创建数据表"
    ‘关闭连接，并释放变量
Set ws = Nothing
    Set myIdx = Nothing
    Set myTable = Nothing
    Set myCat = Nothing
End Sub

‘将工作表中定义的数据类型（字符串型）转换为字段类型VBA常量，即编制一个自定义函数GetConstNo
Function GetConstNo(myStr As String) As Integer
    Select Case myStr
        Case "adBigInt": GetConstNo = 20
        Case "adBinary": GetConstNo = 128
        Case "adBoolean": GetConstNo = 11
        Case "adBSTR": GetConstNo = 8
        Case "adChapter": GetConstNo = 136
        Case "adChar": GetConstNo = 129
        Case "adCurrency": GetConstNo = 6
        Case "adDate": GetConstNo = 7
        Case "adDBDate": GetConstNo = 133
        Case "adDBTime": GetConstNo = 134
        Case "adDBTimeStamp": GetConstNo = 135
        Case "adDecimal": GetConstNo = 14
        Case "adDouble": GetConstNo = 5
        Case "adEmpty": GetConstNo = 0
        Case "adError": GetConstNo = 10
        Case "adFileTime": GetConstNo = 64
        Case "adGUID": GetConstNo = 72
        Case "adIDispatch": GetConstNo = 9
        Case "adInteger": GetConstNo = 3
        Case "adIUnknown": GetConstNo = 13
        Case "adLongVarBinary": GetConstNo = 205
        Case "adLongVarChar": GetConstNo = 201
        Case "adLongVarWChar": GetConstNo = 203
        Case "adNumeric": GetConstNo = 131
        Case "adPropVariant": GetConstNo = 138
        Case "adSingle": GetConstNo = 4
        Case "adSmallInt": GetConstNo = 2
        Case "adTinyInt": GetConstNo = 16
        Case "adUnsignedBigInt": GetConstNo = 21
        Case "adUnsignedInt": GetConstNo = 19
        Case "adUnsignedSmallInt": GetConstNo = 18
        Case "adUnsignedTinyInt": GetConstNo = 17
        Case "adUserDefined": GetConstNo = 132
        Case "adVarBinary": GetConstNo = 204
        Case "adVarChar": GetConstNo = 200
        Case "adVariant": GetConstNo = 12
        Case "adVarNumeric": GetConstNo = 139
        Case "adVarWChar": GetConstNo = 202
        Case "adWChar": GetConstNo = 130
        Case Else: GetConstNo = -1
    End Select
End Function

来顶一下

返回首页

推荐资讯

合肥住建口检测单位招	关于印发安徽省建设工
一般溶液有效期一览表	2022年一建《机电》真

相关文章

无相关信息

栏目更新

栏目热门