多个工作簿导入ACCESS的VBA代码

qiuruosi

我有6个工作簿，每个工作簿有约200-300个工作表，需要批量导入到access，网上找了几个代码，都没有成功。
导入后，所有表的名字不要变，如001.xlsx里的JS2015，导入后表的名称还是JS2015。

导入后，所有表的字段1名称为：日期，有索引（不重复），字段2名称为：数量，无索引



请老师帮忙写个示例的代码，谢谢！！！！

wajour

没必要分多个数据表，一个表就行了增加一个工作簿来源字段即可

zhaogang1960

请参考：
Sub setNewTable()
    Dim Cat As New ADOX.Catalog
    Dim tb1 As ADOX.Table
    Dim cnn As New ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim MyPath As String
    Dim MyName As String
    Dim sh As String
    Dim i As Long
    cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\数据库.accdb"
    MyPath = ThisWorkbook.Path & "\"
    MyName = Dir(MyPath & "*.xlsx")
    Do While MyName <> ""
        Cat.ActiveConnection = "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & MyPath & MyName
        For Each tb1 In Cat.Tables
            If tb1.Type = "TABLE" Then
                sh = Replace(tb1.Name, "'", "")
                If Right(sh, 1) = "$" Then
                    i = i + 1
                    myTable = Replace(sh, "$", "")
                    Set rs = cnn.OpenSchema(adSchemaTables, Array(Empty, Empty, myTable, Empty))
                    If Not rs.EOF Then cnn.Execute "DROP TABLE " & myTable
                    cnn.Execute "CREATE TABLE " & myTable & "(日期 date not null primary key,数量 long not null)"
                    cnn.Execute "INSERT INTO " & myTable & " SELECT f1 as 日期,f2 as 数量 FROM [Excel 12.0;Hdr=No;Database=" & MyPath & MyName & ";].[" & sh & "]"
                End If
            End If
        Next
        MyName = Dir
    Loop
    MsgBox "已成功生成" & i & "个数据表。", vbInformation
    Set Cat = Nothing
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
End Sub

zhaogang1960

上传代码需要审核，图片代之：

zhaogang1960

附件………………
示例.rar (48.3 KB, 下载次数: 370)

2016-5-27 20:09 上传

点击文件名下载附件

jjmysjg

zhaogang1960 发表于 2016-5-27 20:09
附件………………

赵版主，这个不用SQL代码能达到同样的目的吗？
谢谢

zhaogang1960

jjmysjg 发表于 2016-5-27 20:25
赵版主，这个不用SQL代码能达到同样的目的吗？
谢谢

使用Access对象应该可以，要求电脑中安装Access，由于需要打开Access，速度比SQL代码要慢

qiuruosi

zhaogang1960 发表于 2016-5-27 20:09
附件………………

谢谢！！！

jjmysjg

zhaogang1960 发表于 2016-5-27 20:07
请参考：
Sub setNewTable()
    Dim Cat As New ADOX.Catalog

每次登陆，都会查看你等高手的回帖，真是高超。
真希望能看到这个例子的字典答案

zhaogang1960

jjmysjg 发表于 2016-5-29 18:22
每次登陆，都会查看你等高手的回帖，真是高超。
真希望能看到这个例子的字典答案

SQL语言是操作数据库专业语言，字典不能处理数据库问题