Running VBA script with multiple URL's in one go

浪尽此生 提交于 2021-01-29 05:30:27

问题


I've managed to build a vba script that gets data form a website table. Everything works just the way I want it to work. But I need multiple tables and each time the website or table name needs to be different.

As you can see below in the script I first get table 10 from the website, put it in Cell B2 and call it LT BE1 Home In the second sub I'm calling table 11 from the website, put it in Cell B22 (This is one cell below the previous table) and call it LT BE1 Away. In both cases the URL stays the same

Now I want to do repeat this process for 10 other URL's. So the URL, the destination and table name needs to change each time.

How do I go about this? Do I create 20 (2 tables from 10 different URL's) subs or is there another, more automated way to do this?

Public Sub ImportTBLHome()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    Dim sFormula As String
    
    Set sourceSheet = Sheet2
    
    TBL = "LT BE1 Home"
    URL = "https://www.soccerstats.com/homeaway.asp?league=belgium"
    
    With sourceSheet
        Set destCell = .Range("B2")
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
    
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "10"
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With

End Sub

Public Sub ImportTBLAway()

    Dim destCell As Range
    Dim QT As QueryTable
    Dim qtResultRange As Range
    Dim URL As String
    Dim sourceSheet As Worksheet
    Dim TBL As String
    Dim sFormula As String
    
    Set sourceSheet = Sheet2
    
    TBL = "LT BE1 Away"
    URL = "https://www.soccerstats.com/homeaway.asp?league=belgium"
    
    With sourceSheet
        Set destCell = .Range("B22")
        On Error Resume Next
        .ListObjects(TBL).Delete
        On Error GoTo 0
    End With
    
    Set QT = destCell.Worksheet.QueryTables.Add(Connection:="URL;" & URL, Destination:=destCell)
    
    With QT
        .RefreshStyle = xlOverwriteCells
        .WebFormatting = xlNone
        .WebSelectionType = xlSpecifiedTables
        .WebTables = "11"
        .BackgroundQuery = False
        .Refresh
        Set qtResultRange = .ResultRange
        .Delete
    End With
    
    With destCell
        .Worksheet.ListObjects.Add(xlSrcRange, .CurrentRegion, , xlYes).Name = TBL
        sourceSheet.ListObjects(TBL).ShowAutoFilterDropDown = False
    End With

End Sub

来源:https://stackoverflow.com/questions/65669733/running-vba-script-with-multiple-urls-in-one-go

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!