Web Queries in VBA

[Pelham]

Thanks to all of you who have assisted me learn more about VBA through
this News Group - it is working for me slowly ...!

In short, I have created a 20 or so line long VBA script which works
fine for me sometimes. It gets the latest residential real estate data
for Japan's 5 major cities and copies the relevant information straight
into an Excel WorkSheet for me. The code starts with "Sub Queries()"
and ends with "End Sub", but it generates some loops within the code
depending upon how many different web pages it needs to visit each
time. The number of web pages depends upon the number of available
properties in each city whenever I choose to Run the VBA Macro.

However, sometimes there are so many properties that I reach the last
line of the destination WorkSheet and it stops short of what I want...!
Can one of you kind folk please tell me what I have write into the
script to make it automatically open a new destination WorkSheet and
continue copying the data when the current WorkSheet reaches 64,000
lines, please. Also, can you tell where in the code I need to put this
VBA command, please?

Thanks in advance.

 

[Mike Fogleman]

Without seeing the code, I would have to speculate how you are doing this.
You probably have a helper sheet which collects each query one at a time and
from there you copy it to a destination sheet. You must be keeping track of
the LastRow on the destination sheet so you will know where to place the
next query below the last (ie., LastRow = LastRow+2) to insert a blank row
between queries. At that point check to see if LastRow > 64000. If it is,
add a new sheet and re-set the LastRow variable.

If LastRow > 64000 Then
Worksheets.Add
LastRow = 1
End If

Also a tip to prevent file bloating with old Web Query names is to delete
the helper sheet at the end of the queries, and of course add a new helper
sheet at the start of the queries. Thousands of old web query names will be
embedded on that sheet which will continually add to the file size until
that sheet is deleted.

Mike F

 

[Don Guillett]

As always, post your code for comments.
You might want
if lastrow>64000 then destination sheet="sheet3"

 

[Pelham]

Dear Mike and Don

Thanks - very good of you!

Here is the VBA code which keeps looping depending upon how large 'm'
is. In this case 'm' is 250 (I need to enter this each time) which
means the destination WorkSheet will be larger than 64,000 lines
because each time 272 lines are copied.

Since I do not use the term LastRow, what should I do?


Sub Queries()
'
' Queries Macro
' Macro recorded 23/08/2006 by CBRE
'
' Keyboard Shortcut: Ctrl+Shift+Q
'

For m = 1 To 250

With ActiveSheet.QueryTables.Add(Connection:= _

"URL;http://www.chintai.net/chintai/shut...003200000000000000000000000010000000000220&p="
& m _
, Destination:=Range("A" & m + (271 * (m - 1))))
.Name = _

"area_list.cgi?area=shuto_tokyo&city=1190_1200_1210_1220_1230&s=0000000011111100000001000000003200000000000000000000000010000000000220&p="
& m
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "12"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Next m

End Sub

Regards
Pelham

 

[Pelham]

Dear Mike and Don

Thanks - very good of you!

Here is the VBA code which keeps looping depending upon how large 'm'
is. In this case 'm' is 250 (I need to enter this each time) which
means the destination WorkSheet will be larger than 64,000 lines
because each time 272 lines are copied.

Since I do not use the term LastRow, what should I do?


Sub Queries()
'
' Queries Macro
' Macro recorded 23/08/2006 by CBRE
'
' Keyboard Shortcut: Ctrl+Shift+Q
'

For m = 1 To 250

With ActiveSheet.QueryTables.Add(Connection:= _

"URL;http://www.chintai.net/chintai/shut...003200000000000000000000000010000000000220&p="
& m _
, Destination:=Range("A" & m + (271 * (m - 1))))
.Name = _

"area_list.cgi?area=shuto_tokyo&city=1190_1200_1210_1220_1230&s=0000000011111100000001000000003200000000000000000000000010000000000220&p="
& m
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "12"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Next m

End Sub

Regards
Pelham

 

[Mike Fogleman]

Try this:

Sub Queries()
'
' Queries Macro
' Macro recorded 23/08/2006 by CBRE
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
Dim m As Long
Dim LRow As Long

For m = 1 To 250
LRow = m + (271 * (m - 1))
If LRow > 64000 Then
Worksheets.Add
LRow = 1
End If
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.chintai.net/chintai/shut...003200000000000000000000000010000000000220&p="
& m _
, Destination:=Range("A" & LRow))
.Name = _
"area_list.cgi?area=shuto_tokyo&city=1190_1200_1210_1220_1230&s=0000000011111100000001000000003200000000000000000000000010000000000220&p="
& m
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertEntireRows
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "12"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
' .WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Next m
End Sub


Mike F