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?
 

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
L

Legacy 98055

Guest
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
 

tuktuk

Well-known Member
Joined
Nov 13, 2006
Messages
856
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
 

Watch MrExcel Video

Forum statistics

Threads
1,108,791
Messages
5,524,897
Members
409,610
Latest member
db321

This Week's Hot Topics

Top