Web查询刷新错误

Question

我在一个数据表上有3个工作簿Web查询，我有一个下拉对象，其中包含一年中的月份列表（1-12）。我对自动化的想法是根据用户对下拉值的选择更新查询公式，并相应地更新查询公式并刷新。

VBA代码工作正常，但我收到了其中一个查询的消息。

原因是查询（从第2个月更改为第3个月时为ex），还有2行，而不是确切的表格高度。

任何想法如何调试此/绕过此消息。代码如下：

Sub DropDown9_Change()

Dim wbconn As WorkbookConnection, qT As QueryTable
Dim wB As Workbook, wS As Worksheet

'For Each wbconn In ThisWorkbook.Connections
'Debug.Print wbconn.Name & " - " & wbconn.OLEDBConnection.CommandText & " - " & _
'wbconn.OLEDBConnection.SourceDataFile
''wbconn.Refresh
'Next wbconn

Set wB = Workbooks("OH Burdening Template.xlsb")

If ShData.Shapes("Drop Down 9").ControlFormat.Value > _
ShCalendar.Range("B3").Value Then

    MsgBox "Cannot be based on future periods!", vbExclamation

Else
    'Refresh WB queries
    Call Refresh_Queries(ShData.Shapes("Drop Down 9").ControlFormat.Value, wB, ShData)

End If

ShData.Columns.AutoFit

End Sub


Private Function Refresh_Queries(ByVal Period As Integer, ByVal wB As Workbook, _
ByVal thisSheet As Worksheet)

With Application
.StatusBar = "Now refreshing queries on :" & ShData.Name
.ScreenUpdating = False
.EnableEvents = False
End With

Dim I As Integer, LObj As ListObject
Dim strL As Integer, str As String
Dim Pos As Integer
Dim F As String
Dim startPos As Integer

str = "?year=2018&period="
strL = Len(str)

For I = 1 To wB.Queries.Count

    On Error GoTo view_err

    F = wB.Queries(I).Formula
    Pos = VBA.InStr(1, F, str, vbBinaryCompare)
    startPos = Pos + strL

    'Debug.Print F
    'Replacing the period part of the string with the period entered in the dropdown

    F = WorksheetFunction.Replace(F, startPos, 1, Period)
    wB.Queries.Item(I).Formula = F

    'Debug.Print Mid(F, startPos, 1)

Next I

For Each LObj In thisSheet.ListObjects
    Application.StatusBar = "Refreshing " & LObj.Name
    LObj.QueryTable.Refresh False
    Debug.Print LObj.Name & Chr(32) & "Refreshed successfully!"
Next LObj

With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
End With

Set LObj = Nothing

Exit Function

view_err:
Debug.Print LObj.Name & Chr(32) & "Refresh Failed!"
MsgBox Err.Description & " (" & Err.Number & ")", vbExclamation

With Application
.StatusBar = False
.ScreenUpdating = True
.EnableEvents = True
End With

End Function