vba 使用宏设置 Excel 数据连接 (csv)

Set Excel data connection (csv) with macro

提问by Owe Jessen

I have been searching for a solution to the following problem, but haven't found anything that was really helpful: I have an excel sheet with data connections to a number of csv. Sadly, excel does save the connection as absolute paths. Ideally I would be able to set the path as relative paths, but I would settle for a macro that would allow the user to update the connections depending on thisworkbook.pathbefore first use.

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

The project is in a folder d:\project with the excel sheet in d:\project\excel and the csv in d:\project\results. If I would send the project as a zip to some user, and he unzips into c:\my documents\project he will have to reconnect the 10 or so csv.

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

My general idea would be to write a macro along the lines of (no real code, since I'm new to vba, and if I knew the code, I wouldn't have to ask)

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

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

采纳答案by balmerjd

I know this is an old question but I've been searching for the same thing now and I just finally figured this out. Maybe someone else has said the same, but I haven't found it by searching the Googles...

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

Lets say you already have these conditions:

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

1. You already have a data connection set up in a work book (let say it's name is MyData in the connection manager
2. The destination of the data connection is already defined and is some location in Sheet1
3. You have a cell (Say A1 of Sheet2) that has the file name you want to connect to
4. You just need to change the path that the connection is looking so that it follows the path of the work book

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

If this is the case, something like this should do the trick.

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

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

Feel free to modify or tweek that as your case necessitates.

根据您的情况，随意修改或调整。

回答by chris neilsen

You can access the connection path like this

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

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

For a Text data source returns a string like "TEXT;C:\My\Path\Documents\FileName.csv"

对于文本数据源返回一个字符串 "TEXT;C:\My\Path\Documents\FileName.csv"

While testing this I found that changing the path also affected some other properties so you will probably need to reset a bunch of properties after changing the path.

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

回答by Owe Jessen

Thanks for the help, the following is what I came up with in the end:

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

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"))
        .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