Question

我一直在寻找以下问题的解决方案，但是没有发现任何真正有用的东西：我有一张excel表，其中包含与许多csv的数据连接。遗憾的是，excel确实将连接保存为绝对路径。理想情况下，我可以将路径设置为相对路径，但我会选择一个允许用户在首次使用前根据thisworkbook.path更新连接的宏。

项目位于文件夹d：\ project中，其中包含d：\ project \ excel中的excel表和d：\ project \ results中的csv。如果我将项目作为zip发送给某个用户，并且他解压缩到c：\ my documents \ project，他将不得不重新连接10个左右的csv。

我的一般想法是写一个宏（没有真正的代码，因为我是vba的新手，如果我知道代码，我就不用问了）

filepath = thisworkbook.path
cons = thisworkbook.connections
for each cons
   filename = cons.filename
   newpath = filepath & filename
end for

Answer 1

我知道这是一个古老的问题，但我现在一直在寻找同样的事情，我终于想出来了。也许其他人也说了同样的话，但是我还没有通过搜索谷歌来找到它......

假设您已经有这些条件：

您已经在工作簿中设置了数据连接（假设它的名称是连接管理器中的MyData
已定义数据连接的目的地，并且是Sheet1
您有一个单元格（说明Sheet2的A1），其中包含您要连接的文件名
您只需要更改连接所在的路径，使其遵循工作簿的路径

如果是这种情况，这样的事情就可以解决问题。

Dim fileLoc As String
Dim fileName As String

fileLoc = ThisWorkbook.Path
fileName = Sheet2.Range("A1").Value

Dim conString As String
conString = "TEXT;" & fileLoc & "\" & fileName

Sheet1.QueryTables.Item("MyData").Connection = conString

根据您的情况需要随意修改或修改。

Answer 2

您可以像这样访问连接路径

Sub UpdateConnections()
    Dim con As WorkbookConnection
    Dim ConString As String
    For Each con In ThisWorkbook.Connections
        ConString = con.Ranges.Item(1).QueryTable.Connection
        ' Path update code here
    Next
End Sub

对于Text数据源，返回类似"TEXT;C:\My\Path\Documents\FileName.csv"

的字符串

在测试时我发现更改路径也会影响其他一些属性，因此您可能需要在更改路径后重置一堆属性。

Answer 3

感谢您的帮助，以下是我最终提出的建议：

Sub UpdateAllConnections()

    For Each cn In ThisWorkbook.Connections
        cn.Delete
    Next cn

    Dim arrConNames(1) As String
    Dim arrSheetNames(1) As String
    arrConNames(0) = "test1.csv"
    arrConNames(1) = "test2.csv"
    arrSheetNames(0) = "test1"
    arrSheetNames(1) = "test2"

    Dim indCon As Integer

    For indCon = LBound(arrSheetNames) To UBound(arrSheetNames)
        UpdateConnections arrConNames(indCon), arrSheetNames(indCon)
    Next
End Sub

Sub UpdateConnections(ConName As String, SheetName As String)
    FilePath = ThisWorkbook.Path
    ResultPath = Replace(FilePath, "Excel-Shell", "Results")
    ThisWorkbook.Worksheets(SheetName).Select
    ActiveSheet.Cells.Clear
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & ResultPath & "\" & ConName, Destination:=Range( _
        "$A$1"))
        .Name = ConName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

使用宏设置Excel数据连接（csv）

3 个答案: