使用Excel VBA從Internet Explorer提取數據集-如何與彈出的保存/打開/保存進行交互

Question

我將所有代碼都放在這里，以便您查看我的問題。 這段代碼主要是從我的知識，書籍，互聯網和朋友的混合物中哈希出來的。 基本上，在我彈出Internet Explorer詢問我是否要打開文件或保存文件之前，這一切似乎都可以正常工作。

理想情況下，我想在不打開的情況下保存在特定位置。 我花了幾天的時間來反復地嘗試去尋找如何做到這一點，但我一直在努力。 提前致謝！！

Sub WebScraper()

Dim URL As String
Dim postcode As String

'set variables
URL = "http://neighbourhood.statistics.gov.uk/dissemination/"

Set inputs = ActiveWorkbook.Worksheets("Parameters")

Set IE = CreateObject("InternetExplorer.Application")
    IE.Visible = True

RowCounter = 2
ColumnCounter = 1

Do Until IsEmpty(inputs.Cells(RowCounter, 1).Value)

    postcode = inputs.Cells(RowCounter, 1).Value

    'connect to ONS
    Set objIE = ONSConnect(IE, URL)

    'submit postcode
    'Call submitPostcode(objIE, postcode)
    tableURL = getTableURL(objIE, postcode)

    'scrape table to excel
    Call GetTable(tableURL)

    'increment counter
    RowCounter = RowCounter + 1

    'clear postcode variable
    postcode = ""

Loop

    Call quitIE(objIE.Application)

End Sub


'sub to quit IE and cleanup
Sub quitIE(obj As Object)
    obj.Navigate ("javascript: closeChildWindowsAndLogout();")
    obj.Quit
End Sub

'sub to tell macro to wait while page loads
Sub Wait(obj As Object)
    Do While obj.Busy: Loop
    Do While obj.ReadyState <> 4:   Loop
    Application.Wait (Now + TimeValue("0:00:01"))
End Sub



Function ONSConnect(IE, URL As String)

    IE.Navigate URL
    Wait (IE.Application)
    Set ONSConnect = IE

End Function




Function getTableURL(objIE, postcode As String)

Dim postcodeBox As Object
Dim radioButton As Object
Dim showAll As Object
Dim i As Integer
Dim fileExists As Boolean

Set postcodeBox = objIE.Document.getElementById("areaSearchText")
Set radioButton = objIE.Document.getElementById("L141")
Set searchBtns = objIE.Document.getElementsBytagname("BUTTON")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' 
'enter postcode
postcodeBox.Value = postcode

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'check radiobutton
radioButton.Checked = True

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'search
For Each ele In searchBtns
    If ele.Title Like "Search for statistics on an area" Then
        ele.Click
    End If
Next

Wait (objIE.Application)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Navigate to crime and safety page
i = 0
Set showAll = Nothing

While i < objIE.Document.Links.length And showAll Is Nothing

If InStr(objIE.Document.Links(i).innerText, "Crime and Safety") > 0 Then
    Set showAll = objIE.Document.Links(i)
End If

i = i + 1

Wend

If Not showAll Is Nothing Then
showAll.Click
End If

Wait (objIE.Application)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Navigate to fire and rescue service page
i = 0
Set showAll = Nothing

While i < objIE.Document.Links.length And showAll Is Nothing

    If InStr(objIE.Document.Links(i).innerText, "Fire and Rescue Service") > 0 Then
        Set showAll = objIE.Document.Links(i)
    End If

i = i + 1

Wend

If Not showAll Is Nothing Then
    showAll.Click
End If

Wait (objIE.Application)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'we can now get the URL of the tables and pass this to the scraper
'

'getTableURL = objIE.locationurl


''''''''''''''''''''''''''''''''''''''''''''''''''''''
objIE.Document.all("downloadTable").Click

Wait (objIE.Application)


End Function



Sub GetTable(URL)

With Sheets("Data").QueryTables.Add(Connection:= _
    "URL;" & URL, Destination:=Sheets("Data").Range("$A$1")) _
    .Name = "data"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "5"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

End Sub

Answer 1

因為我無法添加評論，但這樣的事情可能有用

Sub GetTable()

Dim putwks作為工作表Dim pstcde作為字符串，newUrl作為字符串

設置putwks = Worksheets（“ parameters”）pstcde = putwks.Range（“ A1”）。Value newUrl =“ http://neighbourhood.statistics.gov.uk/dissemination/NeighbourhoodProfile.do?a=7&b=6275188&c=”＆ pstcde＆“＆g = 6471253＆i = 1001x1012＆j = 6312789＆m = 1＆p = 1＆q = 1＆r = 0＆s = 1417495287339＆enc = 1＆tab = 7＆inWales = false”'以顯示整個url MsgBox newurl

網址直接轉到您的網頁，具體取決於您在參數表中的a1中輸入的內容