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 As Worksheet Dim pstcde As String，newUrl As String

设置putwks =工作表（＆＃34;参数＆＃34;） pstcde = putwks.Range（＆＃34; A1＆＃34;）。值 newUrl =＆＃34; http://neighbourhood.statistics.gov.uk/dissemination/NeighbourhoodProfile.do?a=7&b=6275188&c=＆＃34; ＆安培; pstcde＆amp; ＆＃34;＆安培; G = 6471253＆安培; I = 1001x1012＆安培; J = 6312789＆安培; m = 1时＆安培; P = 1和Q = 1和; R = 0＆安培; S = 1417495287339＆安培; ENC = 1＆安培;标签= 7＆安培; inWales =假＆＃ 34; ＆＃39;显示整个网址 MsgBox newurl

您的网址根据您在参数表上的a1中的内容直接转到您的网页

使用Excel VBA从Internet Explorer中提取数据集 - 如何与保存/打开/另存为弹出窗口进行交互

1 个答案: