Есть ли способ обновить имя файла подключения запроса в Excel с помощью макроса? - PullRequest
Новая
       93

Есть ли способ обновить имя файла подключения запроса в Excel с помощью макроса?

0 голосов
/ 12 июля 2019

В моем файле сводки у меня есть несколько соединений с запросами, которые принимают другой файл Excel в той же папке, что и входной файл для соединения с данными.Имя входного файла периодически меняется, поэтому каждый раз, когда оно меняется, мне нужно переходить к каждому соединению запроса, чтобы изменить имя источника данных, что может быть громоздким.Я пытаюсь найти способ пакетного обновления имени файла подключения с помощью макроса.

Я попытался определить и получить доступ к параметру для имени файла, но не могу найти правильный подход. 

Sub Check_Queries()

    Dim filename As String
    Dim query
    Dim i As Integer

    For Each query In ActiveWorkbook.Connections

        Print query.OLEDBConnection.SourceConnectionFile

    Next query

End Sub

Возвращает эту ошибку:

Ошибка компиляции: метод недопустим без подходящего объекта.

enter image description here

=======================================================================

После того, как я заметил ошибку пропуска «Отладки».перед «печатью» я продолжил разработку решения и обнаружил, что параметром для задачи является Activeworkbook.Queries.Formula .Я написал следующую подпрограмму и проверил ее на работоспособность.Комментарии по улучшению кода приветствуются. 

Sub Update_Queries()

Dim start As Integer
Dim finish As Integer
Dim query
Dim code As String
Dim oldPath As String
Dim newPath As String
Dim intChoice As Integer

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
intChoice = Application.FileDialog(msoFileDialogOpen).Show
If intChoice <> 0 Then
    newPath = Application.FileDialog( _
    msoFileDialogOpen).SelectedItems(1)

    For Each query In ActiveWorkbook.Queries

        code = query.Formula
        'Debug.Print code
        start = InStr(code, "File.Contents(")
        finish = InStr(start + 15, code, "), null, true")

        If start <> 0 And finish <> 0 Then

            oldPath = Mid(code, start + 15, finish - start - 16)
            'Debug.Print oldPath
            If Not oldPath = "" Then

                query.Formula = Replace(code, oldPath, newPath)

            Else

                Debug.Print Right(code, InStr(code, "), null, true"))
                query.Formula = Left(code, start + 14) & newPath & Right(code, InStr(code, "), null, true"))

            End If

            code = ""
            start = Empty
            finish = Empty
            oldPath = ""

        End If

    Next query

End If

End Sub
...