Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Web query automation

Status
Not open for further replies.

Kurupt55

Technical User
Jun 23, 2009
47
NZ
I am having trouble with the following code
Code:
Sub getitems()
    Dim WSD As Worksheet
    Dim WSW As Worksheet
    Dim QT As QueryTable
    
Sheets("Sheet1").Select
    For m = 1 To Range("C1").Value
        Select Case m
            Case Else
                mystr = m
        End Select
        MyName = "Query" & m & "A"
        ConnectString = Range("A" & m).Value
        
        ' 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("D" & m))
        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 = "4"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
        End With
        
        ' Refresh the Query
        QT.Refresh BackgroundQuery:=True
        
    Next m
End Sub
It is stalling on
Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=Range("D" & m))
But I cant seem to figure out why.

I have a list of websites in column A and this is desinged to pull info from each of these sites and put it into column D in the corresponding row.

Any help would be appreciated.
I know I probably havnt described this very well but I have made a very similiar macro work for me.

Thanks

Impossible is Nothing
 
Try this:
Replace
Code:
        Select Case m
            Case Else
                mystr = m
        End Select
with
Code:
        mystr = m
(why did you have a select statement? you aren't performing any actual logic.)


If that doesn't fix it, I would assume that there's something wrong with the ConnectString

Can you give an example of one of the strings you're using to connect?
 


I'd get rid of stuff you're not using.

Also, I'd check the connection string value.

Also EXPLICITLY reference the parent of the QT destination range...
Code:
Sub getitems()
    Dim QT As QueryTable
    
    With Sheets("Sheet1")
        For m = 1 To .Range("C1").Value
            ' On the Workspace worksheet, clear all existing query tables
            For Each QT In .QueryTables
                QT.Delete
            Next QT
            
            ' Define a new Web Query
            Set QT = .QueryTables.Add _
                ( _
                    Connection:=Range("A" & m).Value, _
                    Destination:=.Range("D" & m) _
                )
            With QT
                .Name = "Query" & m & "A"
                .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 = "4"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
            ' Refresh the Query
                .Refresh BackgroundQuery:=True
            End With
        Next m
    End With
End Sub

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thanks skip

Im not really up to scratch with VBA and this is a bit of a hybrid that i was trying to adapt to suit me hence the bits that were not being used.
Not sure why there was a select statement in there but it was working for me so i left it.

Ok as I was writing this I realised what the issue was.
Code:
            Set QT = .QueryTables.Add _
                ( _
                    Connection:="URL;" & Range("A" & m).Value, _
                    Destination:=.Range("D" & m) _
                )
I did not include "URL;".
Thanks so much for your help

Impossible is Nothing
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top