简体   繁体   中英

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.

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

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

where your url goes directly to your page you need according to what you put in a1 on your parameter sheet

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

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