H
Harry J Nathan
Hi
I am using the code below
It is working, but it is only pulling the first page of the query of
information.
For example; if I chose 'A' has my criteria there is more than one page of
information for 'A'.
How can I get all the companys with name start with 'A'
Please help me Thanks Harry
-----
Sub CreateNewQuery()
' Page 335
Dim WSD As Worksheet
Dim WSW As Worksheet
Dim QT As QueryTable
For m = 1 To 27
Select Case m
Case 27
MyStr = "1"
Case Else
MyStr = Chr(64 + m)
End Select
MyName = "Query" & m
ConnectString =
"URL;http://170.3.8.27/cssweb/cssSearchList.asp?letter=" & MyStr
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = m
' On the Workspace worksheet, clear all existing query tables
For Each QT In ActiveSheet.QueryTables
QT.Delete
Next QT
' Define a new Web Query
Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString,
Destination:=Range("A1"))
With QT
.Name = MyName
.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 = xlWebFormattingAll
' .WebTables = "7"
' .WebPreFormattedTextToColumns = True
' .WebConsecutiveDelimitersAsOne = True
' .WebSingleBlockTextImport = False
' .WebDisableDateRecognition = False
' .WebDisableRedirections = False
End With
' Refresh the Query
QT.Refresh BackgroundQuery:=True
Next m
End Sub
I am using the code below
It is working, but it is only pulling the first page of the query of
information.
For example; if I chose 'A' has my criteria there is more than one page of
information for 'A'.
How can I get all the companys with name start with 'A'
Please help me Thanks Harry
-----
Sub CreateNewQuery()
' Page 335
Dim WSD As Worksheet
Dim WSW As Worksheet
Dim QT As QueryTable
For m = 1 To 27
Select Case m
Case 27
MyStr = "1"
Case Else
MyStr = Chr(64 + m)
End Select
MyName = "Query" & m
ConnectString =
"URL;http://170.3.8.27/cssweb/cssSearchList.asp?letter=" & MyStr
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = m
' On the Workspace worksheet, clear all existing query tables
For Each QT In ActiveSheet.QueryTables
QT.Delete
Next QT
' Define a new Web Query
Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString,
Destination:=Range("A1"))
With QT
.Name = MyName
.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 = xlWebFormattingAll
' .WebTables = "7"
' .WebPreFormattedTextToColumns = True
' .WebConsecutiveDelimitersAsOne = True
' .WebSingleBlockTextImport = False
' .WebDisableDateRecognition = False
' .WebDisableRedirections = False
End With
' Refresh the Query
QT.Refresh BackgroundQuery:=True
Next m
End Sub