跨工作簿匹配代码修改

APPLE123

这是论坛 limonet老师写的代码，主要是使用SQL不打开数据源表的情况下核对提取对应数据，可以通过“商品编号”核对，提取“商品名称”、“商品规格”、“生产企业”、“批准文号”4列数据。 limonet代码可以解决2个工作簿相关字段名称不完全一样情况下提取数据。
我想将指定“2.xlsx”文件改为选择Excel文件，关联关系不变、其他条件也不变，于是结合其他老师的代码对上述代码进行修改形成test2，但是无法正常运行·。请问老师，又该如何修改test2代码使之正常运行呢？麻烦老师了，谢谢！

iu950

源数据文件路径好像有误，附件试一试。。。

475039349

是不是要这样的数据，这个公式行不行

limonet

代码在审核。

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, FileName As Variant
    Set Cn = CreateObject("adodb.connection")
    FileName = Application.GetOpenFilename(filefilter:="Excel工作簿文件,*.xls?", MultiSelect:=true)
    If TypeName(FileName) = "Boolean" Then Exit Sub
    Cn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & FileName
    StrSQL = "select 商品名称Xin,商品规格Xin,生产企业Xin,批准文号Xin from [Sheet1$A2:H]a right JOIN [excel 12.0;database=" _
            & ThisWorkbook.FullName & "].[Sheet1$F3:j]b on b.商品编号NEW=a.商品编号Xin"
    Range("G4").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

limonet

还是上传下附件

APPLE123

iu950 发表于 2023-1-4 15:03
源数据文件路径好像有误，附件试一试。。。

谢谢老师的指点帮助！

APPLE123

limonet 发表于 2023-1-4 15:28
代码在审核。

谢谢老师的帮助！

洋务德雷

就是提取的工作簿地址搞错了，其他都可以的。