ADO将EXCEL导入ACCESS有选择地导入

Bettyexcel

各位老师好，

本人工作遇到的问题求助各位老师，谢谢！
想要的结果是：
  1. 总表的按钮只提取  “发货记录表” 工作簿里的”发货类型“=”临时“的那条记录 对应的 ”订单号“，”发货日期“，”发往“ 的3列数据导入到ACCESS的数据表里
  2.  ACCESS的数据表是累积一年的数据的。“发货记录表”则每日有更新。
  3. 当同时有多个  “发货记录表”在文件夹时，将所有的“发货记录表”的临时发货记录都一起导入到ACCESS。
  4.  同一个货品的临时发货可能会重复出现。例如，订单号”0201615810“4月11日临时发货，可能它4月20日又回来了，然后4月30日又临时出库了。
  即，当导入数据到ACCESS时，用4月30日临时发货的那条数据覆盖4月11日临时发货的记录。用最新的数据覆盖旧的数据。

zhaogang1960

请参考:
Sub Macro1()
    Dim Fso As Object, File As Object, cnn As Object, SQL$, arr, arrf$(), i&, j&, l&, u&, v&, n&, d As Object
    Set Fso = CreateObject("Scripting.FileSystemObject")
    ReDim arrf(1 To Fso.GetFolder(ThisWorkbook.Path).Files.Count)
    For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
        If File.Name Like "发货记录表*.xlsx" Then
            n = n + 1
            arrf(n) = File
        End If
    Next
    Set d = CreateObject("scripting.dictionary")
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\Database.accdb"
    For l = n To 1 Step -1
        SQL = "select 订单号,发货日期,发往 from [Excel 12.0;Database=" & arrf(l) & ";].[发货$c5:i] WHERE 订单号 is not null"
        Set rs = cnn.Execute(SQL)
        If Not rs.EOF Then
            arr = rs.GetRows
            For i = 0 To UBound(arr, 2)
                If Not d.Exists(arr(0, i)) Then
                    d(arr(0, i)) = ""
                    SQL = "select * from 临时 where 订单号='" & arr(0, i) & "'"
                    Set rs = CreateObject("adodb.Recordset")
                    rs.Open SQL, cnn, 1, 3
                    If rs.RecordCount = 0 Then
                        rs.AddNew
                        u = u + 1
                    Else
                        v = v + 1
                    End If
                    For j = 0 To rs.Fields.Count - 1
                        rs.Fields(j) = arr(j, i)
                    Next
                    rs.Update
                End If
            Next
        End If
    Next
    MsgBox "添加" & u & "条记录，更新" & v & "条记录。", vbInformation
    rs.Close
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
    Set Fso = Nothing
End Sub

zhaogang1960

请测试附件
发货记录.rar (55.54 KB, 下载次数: 115)

2016-4-12 09:36 上传

点击文件名下载附件

Bettyexcel

zhaogang1960 发表于 2016-4-12 09:37
请测试附件

谢谢赵版。
有个问题是，当“发货类型”是“销售”时不需要导入到ACCESS里了。
也就是ACCESS里只有“发货类型”=“临时”的数据。

zhaogang1960

Bettyexcel 发表于 2016-4-12 09:46
谢谢赵版。
有个问题是，当“发货类型”是“销售”时不需要导入到ACCESS里了。
也就是ACCESS里只有“发 ...

仅需修改一句：
SQL = "select 订单号,发货日期,发往 from [Excel 12.0;Database=" & arrf(l) & ";].[发货$c5:j] WHERE 发货类型='临时'"

zhaogang1960

附件>>>>>>>>>>>>>>>>>>
发货记录.rar (55.96 KB, 下载次数: 44)

2016-4-12 10:00 上传

点击文件名下载附件

Bettyexcel

zhaogang1960 发表于 2016-4-12 10:00
附件>>>>>>>>>>>>>>>>>>

赵版能执行，现在还有一个问题，ACCESS数据表的标题行需要改成英文的，EXCEL发货表的标题行是中文的，如何设定ACCESS的标题行，导入EXCEL时不要标题行？
我已经更改了ACCESS数据表的标题行了，劳烦您再看看？谢谢！

zhaogang1960

Bettyexcel 发表于 2016-4-12 10:43
赵版能执行，现在还有一个问题，ACCESS数据表的标题行需要改成英文的，EXCEL发货表的标题行是中文的，如 ...

SQL = "select * from 临时 where [Order]='" & arr(0, i) & "'"

zhaogang1960

请测试附件
发货记录.rar (56.35 KB, 下载次数: 40)

2016-4-12 10:58 上传

点击文件名下载附件

Bettyexcel

zhaogang1960 发表于 2016-4-12 10:58
请测试附件

谢谢赵版。
还有一个问题，发货记录表的标题实际是这样的，更新了附件，别人的标题我没有权力更改，请您帮忙再看看，谢谢！