How to cause a macro to wait to cont. until web query done

brokenfox

New Member
Joined
Sep 23, 2006
Messages
1
I'm using Office 2003, and gathering web queries, but my macros need to use the info once the query is done. However, everything I've done in trying to .wait or loop until .refreshing is false just causes excel to enter an infinite loop and blocking the query from updating until exiting the loop. How do I get around this?
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
You will likely need to create a reference to your query table and use the events sourced with this object. Download the working example.

QueryTableEvents.zip

This code must go into a class module such as a worksheet, workbook, or custom class. This code is located in sheet1 of the example.

This first example shows you how to reference the sourced events of a querytable that is created on the fly or dynamically...
<table width="100%" border="1" bgcolor="White" style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Private</font> <font color="#0000A0">WithEvents</font> qt <font color="#0000A0">As</font> QueryTable

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> CommandButton1_Click()

       <font color="#0000A0">Set</font> qt = ActiveSheet.QueryTables.Add(Connection:= _
           "URL;http://home.fuse.net/tstom/Book1.html", Destination:=Range("A1"))

       <font color="#0000A0">With</font> qt
           .Name = "Book1"
           .FieldNames = <font color="#0000A0">True</font>
           .RowNumbers = <font color="#0000A0">False</font>
           .FillAdjacentFormulas = <font color="#0000A0">False</font>
           .PreserveFormatting = <font color="#0000A0">True</font>
           .RefreshOnFileOpen = <font color="#0000A0">False</font>
           .BackgroundQuery = <font color="#0000A0">True</font>
           .RefreshStyle = xlInsertDeleteCells
           .SavePassword = <font color="#0000A0">False</font>
           .SaveData = <font color="#0000A0">False</font>
           .AdjustColumnWidth = <font color="#0000A0">True</font>
           .RefreshPeriod = 0
           .WebSelectionType = xlAllTables
           .WebFormatting = xlWebFormattingNone
           .WebPreFormattedTextToColumns = <font color="#0000A0">True</font>
           .WebConsecutiveDelimitersAsOne = <font color="#0000A0">True</font>
           .WebSingleBlockTextImport = <font color="#0000A0">False</font>
           .WebDisableDateRecognition = <font color="#0000A0">False</font>
           .WebDisableRedirections = <font color="#0000A0">False</font>
           .Refresh BackgroundQuery:=False
       <font color="#0000A0">End</font> <font color="#0000A0">With</font>

  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> qt_BeforeRefresh(Cancel <font color="#0000A0">As</font> Boolean)
       MsgBox "The data is now going to be refreshed..."
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> qt_AfterRefresh(ByVal Success <font color="#0000A0">As</font> Boolean)
       MsgBox "Your data has been refreshed. This is where you would run your respondent code..."
       Me.Names(qt.Name).Delete
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

</FONT></td></tr></table><button onclick='document.all("9232006121121906").value=document.all("9232006121121906").value.replace(/<br \/>\s\s/g,"");document.all("9232006121121906").value=document.all("9232006121121906").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("9232006121121906").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="9232006121121906" wrap="virtual">
Private WithEvents qt As QueryTable

Private Sub CommandButton1_Click()

Set qt = ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://home.fuse.net/tstom/Book1.html", Destination:=Range("A1"))

With qt
.Name = "Book1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

End Sub

Private Sub qt_BeforeRefresh(Cancel As Boolean)
MsgBox "The data is now going to be refreshed..."
End Sub

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
MsgBox "Your data has been refreshed. This is where you would run your respondent code..."
Me.Names(qt.Name).Delete
End Sub
</textarea>

This second example does the exact same thing as above except we are referencing an existing querytable. The code for this example is located in sheet2 in the example download.
<table width="100%" border="1" bgcolor="White" style="filter:progid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Private</font> <font color="#0000A0">WithEvents</font> qt <font color="#0000A0">As</font> QueryTable

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> CommandButton1_Click()
       <font color="#0000A0">Set</font> qt = ActiveSheet.QueryTables("Book1")
       qt.Refresh
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> qt_BeforeRefresh(Cancel <font color="#0000A0">As</font> Boolean)
       MsgBox "The data is now going to be refreshed..."
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> qt_AfterRefresh(ByVal Success <font color="#0000A0">As</font> Boolean)
       MsgBox "Your data has been refreshed. This is where you would run your respondent code..."
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table><button onclick='document.all("923200612148843").value=document.all("923200612148843").value.replace(/<br \/>\s\s/g,"");document.all("923200612148843").value=document.all("923200612148843").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("923200612148843").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="923200612148843" wrap="virtual">
Private WithEvents qt As QueryTable

Private Sub CommandButton1_Click()
Set qt = ActiveSheet.QueryTables("Book1")
qt.Refresh
End Sub

Private Sub qt_BeforeRefresh(Cancel As Boolean)
MsgBox "The data is now going to be refreshed..."
End Sub

Private Sub qt_AfterRefresh(ByVal Success As Boolean)
MsgBox "Your data has been refreshed. This is where you would run your respondent code..."
End Sub</textarea>

QueryTableEvents.zip
 
Upvote 0
here is what i can up with

Code:
Sub UpdatePOQntyReducDB()
Dim lookupfilename As String
lookupfilename = "\\Sr\SharedDocs\CSPSharedFILES\POQuantityTrackingTool\POQuantityTrackingReport.xls"

Workbooks.Open lookupfilename
Workbooks("POQuantityTrackingReport.xls").Activate

'locate the cell in first column +1 cell past the previous days upload
'this preps for the next upload
Dim LastRowDB As Long
LastRowDB = Cells(Rows.Count, "D").End(xlUp).Row
Range("A" & LastRowDB).Select

'NEED HELP HERE.goal is to move the actice cell down ONE ROW
'ActiveCell.MoveDown
ActiveCell.Offset(1, 0).Select
'this actually inserts a cell into active cell and therefore moves the data down
'ActiveCell.Insert Shift:=xlDown

'Open the Current Days Invoices
Workbooks("POQntyReductionTool3.xls").Activate

Dim LastRowPO As Long

'Copy CurrentDays Invoices
LastRowPO = Cells(Rows.Count, "D").End(xlUp).Row
Range("A2:M" & LastRowPO).Select
Selection.Copy

'Open the CompilingMaster tab (database) file
Workbooks("POQuantityTrackingReport.xls").Activate
ActiveSheet.Paste

Range("A1").Select
ActiveWorkbook.Save
ActiveWorkbook.Close

Workbooks("POQntyReductionTool3.xls").Activate
Range("A1").Select
MsgBox ("Today's invoices have been updated to the POQuantiyTrackingReport.")

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,557
Messages
6,114,287
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top