VBA从当前单元格值打开工作簿

Question

Hi I have a spreadsheet which I want to use the current cells value to open the url specified there and enter into the column next to it. The URL only contains one set of characters. I tried recording with relative references turned on and got the following:

Sub GETASINV2()
'
' GETASINV2 Macro
'

'
    Selection.Copy
    Application.CutCopyMode = False
    Workbooks.OpenText Filename:="http://upctoasin.com/027616716927", Origin:= _
        xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
        False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    Selection.Copy
    ActiveWindow.ActivateNext
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, -1).Range("A1").Select
End Sub

As you can see it all seems to be relative apart from the filename where it has picked up the value I entered and not the fact that I "copy pasted the value".

Once this is done I want to repeat for the remaining list of urls (around 3000). I can probably find someway of repeating till no more URLS exist but if you know a way would be glad to get help on this part also!

Thank you

Answer 1

I put the link you gave us in rows A1:A10 and ran the following code to get loop through each cell and place the value from the link in the cell to it's right.

I also tested it with 1000 links and it completed in 279 seconds -- so roughly 4 per second. I'd be interested to see if anyone has a quicker method.

Sub GETASINV2()
    Application.ScreenUpdating = False

    Dim sht As Worksheet
    Set sht = ThisWorkbook.Worksheets("Sheet1") 'update for your worksheet name

    Dim inputRange As Range, r As Range
    Set inputRange = sht.Range("A1:A10") 'update for your range

    For Each r In inputRange
        With sht.QueryTables.Add(Connection:= _
            "URL;" & r.Value, Destination:=r.Offset(0, 1))
            .Refresh BackgroundQuery:=False
            .Delete
        End With
    Next r

    Application.ScreenUpdating = True
End Sub

---

Update

Is there a way of it working out the size of the range itself based on the number of records without a gap?

Yes, you can replace this:

 Set inputRange = sht.Range("A1:A10") 

With the following:

 Set inputRange = Range(sht.Range("A1"), sht.Range("A1").End(xlDown)) 

Where A1 is the location of your first link