.Refresh BackgroundQuery 上的运行时 1004 错误答案

【问题标题】：run time 1004 Error on .Refresh BackgroundQuery.Refresh BackgroundQuery 上的运行时 1004 错误
【发布时间】：2015-12-30 23:27:52
【问题描述】：

经过一些更新，我已经能够提出一个接近工作的代码。我遇到的唯一问题之一是宏没有从最后一页抓取数据。对于昨天的数据，有 6 页数据，但宏只抓取第 5 页。但奇怪的是，如果我用 2 天前的相同代码抓取数据，我可以检索所有数据7 或 8 页。我不确定为什么会这样。有任何想法吗？这是更新后的代码。

'Macro to query Delinquency Status Search for DFB Counties
'Run Monday to pull data from Friday

Sub queryActivityDailyMforFWorking()

Dim nextrow As Integer, i As Long
Dim dates
dates = Date - 1

i = 1

Application.ScreenUpdating = False
Application.DisplayStatusBar = True

Do

'i = i + 1
Application.StatusBar = "Processing Page " & i
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
'lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlToLeft).Column + 1

    'With ActiveSheet.QueryTables.Add(Connection:= _
    '"URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i + county + x & "&status=NS&send_date=" & dates & "&search_1.x=1", _
    'Destination:=Range("A" & nextrow))

    With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=11,%2012,%2013,%2014,%2015,%2016,%2017,%2018,%2019,%2020,%2021,%2022,%2023,%2024,%2025,%2026,%2027,%2028,%2080,%2029,%2030,%2031,%2032,%2033,%2034,%2035,%2036,%2037,%2038,%2039,%2040,%2041,%2042,%2043,%2044,%2045,%2046,%2047,%2048,%2049,%2050,%2051,%2052,%2053,%2054,%2055,%2056,%2057,%2058,%2059,%2079,%2060,%2061,%2062,%2063,%2064,%2067,%2068,%2069,%2065,%2066,%2070,%2071,%2072,%2073,%2078,%2074,%2075,%2076,%2077&status=NS&send_date=" & dates & "&search_1.x=1", _
    Destination:=Range("A" & nextrow))





    '.Name = _
    "2015&search_1.x=40&search_1.y=11&date=on&county_1=AL&lic_num_del=&lic_num_rep=&status=NS&biz_name=&owner_name="
    .FieldNames = False
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "10"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False




'autofit columns
Columns("A:G").Select
Selection.EntireColumn.AutoFit

'check for filter, if not then turn on filter
ActiveSheet.AutoFilterMode = False
If Not ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A:G").AutoFilter
End If
i = i + 1
End With

ActiveCell.value = ActiveCell.Value * 2
ActiveCell.Offset(1,0).Select

Loop Until IsEmpty(ActiveCell.Value)

Application.StatusBar = False

'Align text left
Cells.Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

End Sub

【问题讨论】：

即使有，它也会不断迭代。我为不同的搜索编写了相同的代码，即使它的页面少于 25 页，它仍然会继续迭代直到达到 25。
我明白你的意思，但这似乎对我所做的没有意义。从某种意义上说，我正在运行的另一个 Sub，同样的代码提醒你，只是不同的搜索代码，运行没有问题，我知道 13 不存在，但它仍然运行并迭代。
我尝试了不同的日期，代码能够迭代并且没有出现错误
查询在到达 .Refresh BackgroundQuery 之前不会真正执行，因此它实际上可以是之前查询中的任何内容。也许尝试一次注释掉一个，直到您不再收到错误为止。
使用现在的代码，如果你要执行代码，它会抛出错误。但是，当我将日期更改为从 12/16 开始抓取信息时，它可以毫无问题地进行抓取。我只是不明白为什么我可以从其他日子刮取数据，而不是昨天。我已经尝试在 .refresh backgroundquery 之前注释掉行，但我仍然收到相同的错误。

标签： vba excel excel-2010

【解决方案1】：

我的解决方案（也许添加格式以将其带回 A 列）：

Sub QueryDelinquencyTest()
Dim nextrow As Integer, i As Integer
Dim dates
dates = Date - 1

Application.ScreenUpdating = False
Do While i < 25 'this is the page range to be captured.
Application.StatusBar = "Processing Page " & i
nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=AL&status=NS&send_date=" & dates & "&search_1.x=1", _
    Destination:=Range("A" & nextrow))
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "10"
    .WebPreFormattedTextToColumns = False
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=True
End With

i = i + 1
Loop
Cells.Select
With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

End Sub

【讨论】：

我认为格式已经存在，可以从 A 列开始？也许我错过了那部分，看不到它在哪里。我看到了您所做的更改，但似乎无法弄清楚您为使列在 A 列中开始而采取的措施。此外，当我尝试添加自动过滤器时，我收到一条错误消息，指出范围的自动过滤器方法课程失败。有什么想法吗？
您将如何跟踪何时到达搜索结果的末尾？我想告诉代码在没有数据可提取时停止搜索。您认为我是否必须修改此代码以合并 html 标签？
列 A 到 G 有格式设置，但这些列中唯一的内容是底部有一些未找到的信息；其他一切都被推到了右边。您必须运行它，看看它做了什么，然后决定如何格式化。至于当你到达终点时停止它，只需执行类似的操作，如果找不到右箭头按钮然后格式化并退出
是的，我运行宏并看到实际信息被推到了右侧。我会再玩一些。如果箭头不退出，我将如何开始编码？它会找到那个右箭头按钮的 html 元素吗？
当它进入一个空白页面时，它会显示“未找到活动信息”。在 A 列中。我会更改您的 Do while 以说出类似于单元格 a 中的值不等于“未找到活动信息”的内容。

【解决方案2】：

这是我目前为每个县声明变量时的代码。

'Macro to query Delinquency Status Search for DFB Counties
'Run Monday to pull data from Friday

Sub queryActivityDailyMforF()

Dim nextrow As Integer, i As Long
Dim dates
dates = Date - 1
Dim x, county1, county2, county3, county4, county5, county6, county7, county8, county9, county10, county11, county12
county1 = "county_1=16"
county2 = "county_1=21"
county3 = "county_1=23"
county4 = "county_1=32"
county5 = "county_1=36"
county6 = "county_1=41"
county7 = "county_1=46"
county8 = "county_1=53"
county9 = "county_1=54"
county10 = "county_1=57"
county11 = "county_1=60"
county12 = "county_1=66"

'Dim myString
'myString = "No Activity Information Found"
'Dim lastRow As Long
'Dim county
'Dim site As String

'Dim rng As Range
'Dim firstCell As String

'lastRow = Sheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
Application.DisplayStatusBar = True

'If Not rng Is Nothing Then firstCell = rng.Address

'Do Until myString <> lastRow And InStr("&county_1=66", "St. Lucie")
Do

'Do While i < 4
'For i = 1 To lastRow
'Set rng = Sheets("sheet2").Range("A:A").find(What:=Cells(i, 1), LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows)
'Do While lastRow <> myString
    Application.StatusBar = "Processing Page " & i
    nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    'With ActiveSheet.QueryTables.Add(Connection:= _
     '   "URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=16&county_1=21&county_1=23&county_1=32&county_1=36&county_1=41&county_1=46&county_1=53&county_1=54&county_1=57&county_1=60&county_1=66&status=NS&send_date=" & dates & "&search_1.x=1", _
      '  Destination:=Range("A" & nextrow))

        With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & county & x & "&status=NS&send_date=" & dates & "&search_1.x=1", _
        Destination:=Range("A" & nextrow))



        '.Name = _
        "2015&search_1.x=40&search_1.y=11&date=on&county_1=AL&lic_num_del=&lic_num_rep=&status=NS&biz_name=&owner_name="
        .FieldNames = False
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "10"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False

    'autofit columns
    Columns("A:G").Select
    Selection.EntireColumn.AutoFit

   'check for filter, if not then turn on filter
   ActiveSheet.AutoFilterMode = False
    If Not ActiveSheet.AutoFilterMode Then
    ActiveSheet.Range("A:G").AutoFilter
    End If

    'If Not rng Is Nothing Then
     '   If rng.Address = firstCell Then Exit Do
      '  End If


 'site = "https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=16&county_1=21&county_1=23&county_1=32&county_1=36&county_1=41&county_1=46&county_1=53&county_1=54&county_1=57&county_1=60&county_1=66&status=NS&send_date=" & dates & "&search_1.x=1"
 'county = "&coutny_1=66"



End With
'Next
i = i + 1
Loop Until x = 12

x = x + 1
'Loop Until InStr(site, county) And ActiveCell.Value = myString
'Wend
Application.StatusBar = False

'Align text left
Cells.Select
With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

'Next
'Loop

End Sub

【讨论】：

你必须在循环之前设置 x = 1。我也没有设置任何东西，所以“处理页面”&我将无效。
让我给你一些建议，我是通过艰难的方式学到的，一次只做一件，然后在继续下一件之前让它工作。例如，您更改了循环结构并创建了所有这些变量，因此如果失败，您将不知道哪个部分不起作用。
是的，我知道。我到处都是。我只想完成这件事。哈哈。我会继续努力，看看我能想出什么。谢谢