VBA自动更新数据连接数据源路径

张文洲

最近经常遇见关于更新数据连接数据源路径的问题，下面这段代码应该可以实现更新数据源路径为当前工作簿路径，有需要的可以尝试下

1. Private Sub Workbook_Open()
   
2.     Dim strCon As String, iPath As String, i As Integer, iFlag As String, iStr As String, oledb As OLEDBConnection
   
3.     For i= 1 To ActiveWorkbook.Connections.Count
   
4.         Set oledb = ActiveWorkbook.Connections(i).OLEDBConnection
   
5.         strCon = oledb.Connection
   
6.         Select Case Left(strCon, 5)
   
7.             Case "ODBC;"
   
8.             iFlag = "DBQ="
   
9.             Case "OLEDB"
   
10.             iFlag = "Source="
    
11.             Case Else
    
12.             Exit Sub
    
13.         End Select
    
14.         iStr = Split(Split(strCon, iFlag)(1), ";")(0)
    
15.         iPath = Left(iStr, InStrRev(iStr, "") - 1)
    
16.         With oledb
    
17.             .Connection = VBA.Replace(strCon, iPath, ThisWorkbook.Path)
    
18.             .CommandText = VBA.Replace(.CommandText, iPath, ThisWorkbook.Path)
    
19.         End With
    
20.     Next
    
21. End Sub

复制代码