通用SQL多工作簿多数据透视表适应路径

jhtjj

受wuxiang_123的SQL多工作簿适应路径(我师傅的代码)的一文启发，本文编写了通用SQL多工作簿多数据透视表适应路径的EXCEL程序,程序如下：

1. Private Sub Workbook_Open()
   
2. Dim strCon As String, iPath As String, iFlag As String, iStr As String
   
3. Dim QT As QueryTable
   
4. Dim sh As Worksheet
   
5. '定义变量
   
6. On Error Resume Next
   
7. For Each sh In Worksheets
   
8. For Each QT In sh.QueryTables
   
9. '遍历数据透视表中缓存连接信息
   
10. strCon = QT.Connection
    
11. '将数据透视表中缓存连接信息赋值给变量strCon
    
12. Select Case Left(strCon, 5) 'select case语句,条件为strCon变量中从左侧取5个字符
    
13. Case "ODBC;" '用于判断缓存连接信息中的数据连接方式,如果是ODBC方式
    
14. iFlag = "DBQ=" '将"DBQ=" 赋值给变量iFlag
    
15. Case "OLEDB" '用于判断缓存连接信息中的数据连接方式,如果是OLEDB方式
    
16. iFlag = "Source=" '将"DBQ=" 赋值给变量iFlag
    
17. Case Else
    
18. Exit Sub
    
19. End Select
    
20. iStr = Split(Split(strCon, iFlag)(1), "" & Split(Split(strCon, "")(UBound(Split(strCon, ""))), ";")(0))(0) '在变量strCon中截取文件路径信息
    
21. iPath = ThisWorkbook.Path '获取当前活动工作簿的完全路径
    
22. With QT '替换数据透视表中缓存信息中的文件完全路径和本工作簿文件名
    
23. .Connection = VBA.Replace(.Connection, iStr, iPath)
    
24. .CommandText = VBA.Replace(.CommandText, iStr, iPath)
    
25. .Connection = VBA.Replace(.Connection, Split(Split(strCon, "")(UBound(Split(strCon, ""))), ";")(0), ThisWorkbook.Name)
    
26. End With
    
27. Next
    
28. Next
    
29. End Sub
    

复制代码

说明：把汇总.xls以及相应参加汇总的文件无论放在什么地方（当然是同一文件夹下。），哪怕改了汇总.xls文件名，打开后，里面的所有数据透视表的SQL都能够自动更改汇总路径，适应汇总数据，或原来参加汇总的文件在汇总.xls文件下的子文件夹里，也是可行的。

474489459

请检查一下，不行啊！