Web query automation

[Kurupt55]

I am having trouble with the following 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

 

[Gruuuu]

Try this:
Replace

        Select Case m
            Case Else
                mystr = m
        End Select

with

        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?

 

[SkipVought]

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...

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]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[Kurupt55]

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.

            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