Excel удаляет соединение таблицы запросов при выполнении макроса VBA - PullRequest
2 голосов
/ 30 января 2020

Я борюсь с интересной проблемой, с которой я никогда раньше не сталкивался и, похоже, не могу найти никакой информации об онлайн. Вот настройка:

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

Вот код:

Sub WQ_Refresh(wsname As String, wqName As String, wqURL As String, strFC As String)

Dim ws As Worksheet
Dim wq As QueryTable
Dim errno As Long
Dim loopcnt As Integer
Dim refreshTime As Double
Dim lastrow As Long

refreshTime = Timer

Application.StatusBar = "Now downloading " & wqName & " for " & strFC

If wsname = "" Then Exit Sub

Set ws = ThisWorkbook.Sheets(wsname)

    If ws.QueryTables.Count > 0 Then

    Set wq = ws.QueryTables(1)

    wq.Delete

End If

lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

If lastrow > 1 Then lastrow = lastrow + 1

Set wq = ws.QueryTables.Add(Connection:="URL;" & wqURL, Destination:=ws.Range("A" & lastrow))

errno = 1
loopcnt = 0

Do While Not (errno = 0 And loopcnt < 10)

    On Error Resume Next

    With wq

        .FieldNames = True
        .WebFormatting = xlWebFormattingNone
        .WebSelectionType = xlAllTables
        .Refresh BackgroundQuery:=False
        .Delete

    End With

    loopcnt = loopcnt + 1
    errno = Err.Number

    If loopcnt = 10 Then HashtagFail wqName

    On Error GoTo 0

Loop

If lastrow > 1 Then

   ws.Rows(lastrow - 1 & ":" & lastrow).Delete

End If

Set wq = Nothing

Application.StatusBar = "Downloaded " & wqName & " in " & Round(Timer - refreshTime, 0) & " seconds"

По некоторым причинам, которые я не могу понять, функция wq.Delete правильно удалит созданный wq, но также удалит соединение на другом листе, который устанавливается вручную как часть файла.

Чтобы быть понятным - это не УДАЛИТЬ соединение. Он все еще там, но если вы посмотрите на его свойства и go на вкладку Используется в, он показывает, что больше не используется ни на одном листе.

Я понятия не имею, почему это происходит - для меня, код должен явно удалять только соединение на листе в l oop и не влиять на любые другие соединения в файле.

Это похоже на фундаментальную ошибку в Excel, но мне бы очень хотелось, чтобы у вас был какой-либо ввод потому что я полностью застрял.

Ценю вашу помощь!

1 Ответ

0 голосов
/ 19 февраля 2020

На основе формы комментария @DeanDeVilliers Решение, которое работало, заключалось в том, чтобы ссылаться на таблицу по имени. Вот рабочий код, если кому-то интересно

Sub WQ_Refresh(wsname As String, wqName As String, wqURL As String, strFC As String)
Dim ws As Worksheet
Dim wq As QueryTable
Dim errno As Long
Dim loopcnt As Integer
Dim refreshTime As Double
Dim lastrow As Long

refreshTime = Timer

Application.StatusBar = "Now downloading " & wqName & " for " & strFC

If wsname = "" Then Exit Sub

Set ws = ThisWorkbook.Sheets(wsname)

    If ws.QueryTables.Count > 0 Then ws.QueryTables("WQ_" & wqName).Delete





lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row

If lastrow > 1 Then lastrow = lastrow + 1

Set wq = ws.QueryTables.Add(Connection:="URL;" & wqURL, Destination:=ws.Range("A" & lastrow))

errno = 1
loopcnt = 0

Do While Not (errno = 0 And loopcnt < 10)

    On Error Resume Next

    With wq

        .FieldNames = True
        .WebFormatting = xlWebFormattingNone
        .WebSelectionType = xlAllTables
        .Refresh BackgroundQuery:=False
        .Name = "WQ_" & wqName
        ' .Delete

    End With

    loopcnt = loopcnt + 1
    errno = Err.Number

    If loopcnt = 10 Then HashtagFail wqName

    On Error GoTo 0

ws.QueryTables("WQ_" & wqName).Delete

Loop

If lastrow > 1 Then

   ws.Rows(lastrow - 1 & ":" & lastrow).Delete

End If

Set wq = Nothing

Application.StatusBar = "Downloaded " & wqName & " in " & Round(Timer - refreshTime, 0) & " seconds"

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...