简体   繁体   English

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

[英]Using Excel VBA to pull datasets from internet explorer - how to interact with save/open/save as pop up

I've put all of my code here so you can take a look at my problem. 我将所有代码都放在这里,以便您查看我的问题。 This code has mainly been hashed together from a mixture of my knowledge, books, the internet and friends. 这段代码主要是从我的知识,书籍,互联网和朋友的混合物中哈希出来的。 Basically it all seems to be working until I get the internet explorer pop-up asking if I want to open the file or save it. 基本上,在我弹出Internet Explorer询问我是否要打开文件或保存文件之前,这一切似乎都可以正常工作。

Ideally I'd like to save without opening, in a specific location. 理想情况下,我想在不打开的情况下保存在特定位置。 I've spent a couple of days looking on and off to try to find how to do this and I'm struggling. 我花了几天的时间来反复地尝试去寻找如何做到这一点,但我一直在努力。 Thanks in advance!! 提前致谢!!

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

since i cant add a comment yet something like this maybe usefull 因为我无法添加评论,但这样的事情可能有用

Sub GetTable()

Dim putwks As Worksheet Dim pstcde As String, newUrl As String Dim putwks作为工作表Dim pstcde作为字符串,newUrl作为字符串

Set 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" 'to show the entire url MsgBox 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

where your url goes directly to your page you need according to what you put in a1 on your parameter sheet 网址直接转到您的网页,具体取决于您在参数表中的a1中输入的内容

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM