0

我在我的个人xlsb 文件中编写了一个代码，该代码使用网络查询自动从网站中提取报告。当我单独打开每个 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

任何帮助将不胜感激

4

1 回答 1

0

试试这个正确的格式，你错过了一些.在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
于 2013-09-20T00:57:08.180 回答