Question

我在personalxlsb文件中编写了一个代码，该代码使用webquery自动从网站提取报告。当我单独打开每个excel工作簿并运行代码时，代码（在下面直接列出）非常有用。 z，x和y在Sheet1上为每个工作簿引用一个值（它们是对其他数据的vlookup）。我看了看，但无法找到解决方案。谢谢你提前帮忙！

Dim ws As Worksheet
z = Worksheets("Sheet1").Range("$A$1").Value
y = Worksheets("Sheet1").Range("$A$2").Value
x = Worksheets("Sheet1").Range("$A$3").Value

For Each ws In Worksheets
If ws.Name = "ATB by Branch" Then
With Worksheets("ATB by Branch").QueryTables.Add(Connection:= _
    "URL;https://pe.---.com/---/clients/---" & y & "/amr/amr" & z & "/tb01" & x _
    , Destination:=Worksheets("ATB by Branch").Range("$A$1"))
    .Name = "tb0120130903110631ash"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwrtiteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=True
End With

ElseIf ws.Name = "ATB by Ins by Sum" Then

问题是，当我尝试在文件夹中为每个文件（下面列出）运行此代码时，代码停止提取数据，我怀疑问题是z，y和x变量不再拉正确的价值观。

Dim wkbOpen As Workbook
Dim sht As Worksheet
Dim MyPath As String
Dim MyFile As String

MyPath = "C:\Documents and Settings\tlear\Desktop\Copy of VBA Physician Files\"
MyFile = Dir(MyPath & "*.xls")

Do While Len(MyFile) > 0
    Set wkbOpen = Workbooks.Open(Filename:=MyPath & MyFile)
    With wkbOpen


Dim ws As Worksheet
z = Worksheets("Sheet1").Range("$A$1").Value
y = Worksheets("Sheet1").Range("$A$2").Value
x = Worksheets("Sheet1").Range("$A$3").Value

For Each ws In Worksheets
If ws.Name = "ATB by Branch" Then
With Worksheets("ATB by Branch").QueryTables.Add(Connection:= _
    "URL;https://pe.----.com/---/clients/----" & y & "/amr/amr" & z & "/tb01" & x _
    , Destination:=Worksheets("ATB by Branch").Range("$A$1"))
    .Name = "tb0120130903110631ash"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlOverwrtiteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=True
 End With

非常感谢任何帮助

Answer 1

尝试正确格式化后，您错过了.块中的某些With。这编译好，但我无法测试。只是好奇你最后需要关闭它们吗？

Sub SO_18897512()
    Dim MyPath As String
    Dim MyFile As String
    Dim ws As Worksheet

    MyPath = "C:\Documents and Settings\tlear\Desktop\Copy of VBA Physician Files\"
    MyFile = Dir(MyPath & "*.xls")

    Do While Len(MyFile) > 0
        With Workbooks.Open(Filename:=MyPath & MyFile)
            Z = .Worksheets("Sheet1").Range("$A$1").Value
            y = .Worksheets("Sheet1").Range("$A$2").Value
            x = .Worksheets("Sheet1").Range("$A$3").Value

            For Each ws In .Worksheets
                If ws.Name = "ATB by Branch" Then
                    With ws.QueryTables.Add( _
                        Connection:= "URL;https://pe.----.com/---/clients/----" & y & "/amr/amr" & Z & "/tb01" & x , _
                        Destination:=ws.Range("$A$1"))
                        .Name = "tb0120130903110631ash"
                        .FieldNames = True
                        .RowNumbers = False
                        .FillAdjacentFormulas = False
                        .PreserveFormatting = True
                        .RefreshOnFileOpen = False
                        .BackgroundQuery = True
                        .RefreshStyle = xlOverwrtiteCells
                        .SavePassword = True
                        .SaveData = True
                        .AdjustColumnWidth = True
                        .RefreshPeriod = 0
                        .WebSelectionType = xlEntirePage
                        .WebFormatting = xlWebFormattingNone
                        .WebPreFormattedTextToColumns = True
                        .WebConsecutiveDelimitersAsOne = True
                        .WebSingleBlockTextImport = False
                        .WebDisableDateRecognition = False
                        .WebDisableRedirections = False
                        .Refresh BackgroundQuery:=True
                    End With
                End If
            Next
        End With
    Loop
End Sub

文件循环没有拉动正常代码中引用的工作表范围

1 个答案: