johnnapoletano
New Member
- Joined
- Jul 27, 2006
- Messages
- 7
I've been trying to figure out why Dynamic Web Query this code doesn't work 100% of the time. I know I'm not the only one having this problem, but I have yet to see an answer that Works on the internet. I'm trying to grab Geocodes using both a Free and Paid service, they both fail. Here's a sample address query, basically the code is based off of http://www.mrexcel.com/tip072.shtml and the book code too.
Sample Query you can pop into your browser:
http://rpc.geocoder.us/service/csv?address=310+W+Lake+St,+Elmhurst,+Illinois+60126
Error 1004 Occurs on Refresh Property:
QT.Refresh BackgroundQuery:=False
I put in extra Clears and Deletes thinking the queries and names where bunching up or something. Save after 5 was a test to see if that was an issue per Microsoft help (didn't help). Message box and timer to slow down the code, theres a 15 second throttle on the free service. Web or Text who cares? I would just like all the connections to connect and data to import. When it runs, everything else works fine, just the Error 1004. Here's the full code:
Sub Web_Query()
Dim WQ As Worksheet
Dim WD As Worksheet
Set WQ = Worksheets("Query")
Set WD = Worksheets("Database")
Dim QT As QueryTable
WQ.Activate
Columns("D:AZ").Select
Selection.ClearContents
WQ.Cells(1, 1).Select
For Each MyName In ActiveSheet.Names
MyName.Delete
Next MyName
OutCol = 8
OutRow = 1
FinalRow = WQ.Cells(65536, 1).End(xlUp).Row
For i = 2 To FinalRow
ConnectString = "URL;" & WQ.Cells(i, 2).Value
MsgBox "Query Row: " & i & ") " & WQ.Cells(i, 2).Value
Application.StatusBar = i
' Save after 5 queries
If i Mod 5 = 0 Then
ThisWorkbook.Save
End If
MyName = "Query" & i
' Define a new Web Query
Set QT = WQ.QueryTables.Add(Connection:=ConnectString, _
Destination:=WQ.Cells(OutRow, OutCol))
With QT
.Name = MyName
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = True
.WebDisableDateRecognition = True
.WebDisableRedirections = True
End With
' Refresh the Query
Application.Wait Now + TimeValue("00:00:16")
QT.Refresh BackgroundQuery:=False
'Change from a live query to values
WQ.Cells(OutRow, OutCol).Value = WQ.Cells(OutRow, OutCol).Value
For Each QT In WQ.QueryTables
QT.Delete
Next QT
' Copy to Database
WD.Cells(i, 1).Value = WQ.Cells(i, 1).Value
WD.Cells(i, 3).Value = WQ.Cells(i, 2).Value
WD.Cells(i, 2).Value = WQ.Cells(OutRow, OutCol).Value
Next i
End Sub
Please help or direct me to the "Bugs" section of the
http://www.mrexcel.com/tip072.shtml and the book. I'm using Excel 2003.
Thanks.
Sample Query you can pop into your browser:
http://rpc.geocoder.us/service/csv?address=310+W+Lake+St,+Elmhurst,+Illinois+60126
Error 1004 Occurs on Refresh Property:
QT.Refresh BackgroundQuery:=False
I put in extra Clears and Deletes thinking the queries and names where bunching up or something. Save after 5 was a test to see if that was an issue per Microsoft help (didn't help). Message box and timer to slow down the code, theres a 15 second throttle on the free service. Web or Text who cares? I would just like all the connections to connect and data to import. When it runs, everything else works fine, just the Error 1004. Here's the full code:
Sub Web_Query()
Dim WQ As Worksheet
Dim WD As Worksheet
Set WQ = Worksheets("Query")
Set WD = Worksheets("Database")
Dim QT As QueryTable
WQ.Activate
Columns("D:AZ").Select
Selection.ClearContents
WQ.Cells(1, 1).Select
For Each MyName In ActiveSheet.Names
MyName.Delete
Next MyName
OutCol = 8
OutRow = 1
FinalRow = WQ.Cells(65536, 1).End(xlUp).Row
For i = 2 To FinalRow
ConnectString = "URL;" & WQ.Cells(i, 2).Value
MsgBox "Query Row: " & i & ") " & WQ.Cells(i, 2).Value
Application.StatusBar = i
' Save after 5 queries
If i Mod 5 = 0 Then
ThisWorkbook.Save
End If
MyName = "Query" & i
' Define a new Web Query
Set QT = WQ.QueryTables.Add(Connection:=ConnectString, _
Destination:=WQ.Cells(OutRow, OutCol))
With QT
.Name = MyName
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = False
.WebConsecutiveDelimitersAsOne = False
.WebSingleBlockTextImport = True
.WebDisableDateRecognition = True
.WebDisableRedirections = True
End With
' Refresh the Query
Application.Wait Now + TimeValue("00:00:16")
QT.Refresh BackgroundQuery:=False
'Change from a live query to values
WQ.Cells(OutRow, OutCol).Value = WQ.Cells(OutRow, OutCol).Value
For Each QT In WQ.QueryTables
QT.Delete
Next QT
' Copy to Database
WD.Cells(i, 1).Value = WQ.Cells(i, 1).Value
WD.Cells(i, 3).Value = WQ.Cells(i, 2).Value
WD.Cells(i, 2).Value = WQ.Cells(OutRow, OutCol).Value
Next i
End Sub
Please help or direct me to the "Bugs" section of the
http://www.mrexcel.com/tip072.shtml and the book. I'm using Excel 2003.
Thanks.