4

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

该项目位于文件夹 d:\project 中，excel 工作表位于 d:\project\excel 中，csv 位于 d:\project\results 中。如果我将项目作为 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
4

3 回答 3

2

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

假设您已经具备以下条件：

  1. 您已经在工作簿中设置了数据连接（假设它的名称是连接管理器中的 MyData
  2. 数据连接的目的地已经定义并且在 Sheet1 中的某个位置
  3. 您有一个单元格（例如 Sheet2 的 A1），其中包含要连接到的文件名
  4. 您只需要更改连接正在查找的路径，使其遵循工作簿的路径

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

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

根据您的情况需要随时修改或调整。

于 2015-11-04T12:55:56.800 回答
1

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

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;C:\My\Path\Documents\FileName.csv"

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

于 2012-08-24T20:57:40.857 回答
1

感谢您的帮助，以下是我最后想到的：

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
于 2012-08-27T12:07:51.017 回答