VBA+SQL怎么实现同文件夹下跨簿同名字sheet里相同自定义名称范围或打印区域的合并

未来精英

详细情况：
用VBA+SQL怎么实现："同文件夹——跨工作簿——同名字sheet——相同自定义名称范围或打印区域"中内容查询与合并.
例如第一步打开”1-公园美地总承包工程信息卡.xls“工作簿，然后打开”总包造价信息卡“sheet，再将各工作簿”总包造价信息卡“sheet中的名叫”单方造价“自定义区域按其工作簿名称字段+首行列字段汇总到”汇总表.xlsx"的"单方造价"sheet表中【我已提前自定义好区域名称（黄色区域），文件夹中每个工作簿均提前自定义好名叫”单方造价“的区域】

我想用这个VBA+SQL，但没有能很好的实现效果（您能否改进代码？）：
Sub Test4()
    Dim Conn As Object, Rst As Object
    Dim strConn As String, strSQL As String
    Dim i As Integer, PathStr As String
    Set Conn = CreateObject("ADODB.Connection")
    Set Rst = CreateObject("ADODB.Recordset")
    PathStr = ThisWorkbook.FullName   '设置工作簿的完整路径和名称
    Select Case Application.Version * 1    '设置连接字符串,根据版本创建连接
    Case Is <= 11
        strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    Case Is >= 12
        strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    End Select
    '设置SQL查询语句
    strSQL = "请写入SQL语句"
    Conn.Open strConn    '打开数据库链接
    Set Rst = Conn.Execute(strSQL)    '执行查询，并将结果输出到记录集对象
    With Sheet3
        .Cells.Clear
        For i = 0 To Rst.Fields.Count - 1    '填写标题
            .Cells(1, i + 1) = Rst.Fields(i).Name
        Next i
        .Range("A2").CopyFromRecordset Rst
        .Cells.EntireColumn.AutoFit  '自动调整列宽
        .Cells.EntireColumn.AutoFit  '自动调整列宽
    End With
    Rst.Close    '关闭数据库连接
    Conn.Close
    Set Conn = Nothing
    Set Rst = Nothing
End Sub

opiona

http://club.excelhome.net/thread-1409141-1-1.html

未来精英

opiona 发表于 2018-8-10 11:15
http://club.excelhome.net/thread-1409141-1-1.html

EH侠圣，你好！用了一下你的表格，比如2_多工作簿指定工作表，指定几个位置的数据汇总中有个问题就是，第四行标题行不管填什么只要不是空的，都可以取出数来，感觉是不是程序有点bug。还有就是它能否实现模糊匹配呢？

未来精英

opiona 发表于 2018-8-10 11:15
http://club.excelhome.net/thread-1409141-1-1.html

那VBA+SQL怎么实现不同文件夹下跨簿同名字sheet的自动更新合并，且同时实现各文件的超链接并连接动态透视表和透视图呢？有有注释的代码吗？