CODEWITHSUNDEEP
excelvba
rcm19
rcm19

Reputation: 37

Macro to Change Dates and Generate Spreadsheet on Website

There is a website I routinely use to generate a spreadsheet. The only items on the website are a "Start Date" field, an "End Date" field, and a "Go" button. After I enter my date range and click "Go" it downloads a .cfm file, I click open with excel, excel warns the file has a different extension and verifies it's not corrupted and I click open and I have the data I need and from there have a macro to maniupulate as needed. I'm looking to automate the steps:

Go to website
Change Start Date
Change End Date
Click Go
Click Open file
Agree to open different extension

The macro I've used before to get data from a website only copies and pastes data visible on a specific url and is as follows. I manipulate the url on my Input spreadsheet to manipulate the data.

Dim addWS As Worksheet
Set addWS = Sheets.Add(Before:=Sheets("Input"))
addWS.Name = "Website Data"


Dim myurl As String

myurl = Worksheets("Input").Range("G4")

With Worksheets("Website Data").QueryTables.Add(Connection:= _
   "URL;" & myurl, _
   Destination:=Range("A3"))

  .BackgroundQuery = True
  .TablesOnlyFromHTML = True
  .Refresh BackgroundQuery:=False
  .SaveData = True
End With

Thank you.

Upvotes: 1

Views: 814

Answers (1)

mr261
mr261

Reputation: 26

The following code works for me. You will have to change "startDate" and "endDate" depending on how the specific website names the input boxes.

Sub test_fetch()

  Dim IE As Object
  Dim objElement As Object
  Dim objCollection As Object
  Dim i As Long


  Dim Doc As Object, lastrow As Long, tblTR As Object

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

  IE.navigate "http://your_website"

  Do While IE.Busy
    Application.Wait DateAdd("s", 1, Now)
  Loop

  Application.StatusBar = "Fetching Website Data. Please wait..."

  Set objCollection = IE.document.getElementsByTagName("input")

  i = 0
  While i < objCollection.Length
    If objCollection(i).Name = "startDate" Then

    ' Set text for start date
        objCollection(i).Value = "09/15/2013"

    ElseIf objCollection(i).Name = "endDate" Then
    ' Set text for end date
        objCollection(i).Value = "09/21/2013"

    Else
        If objCollection(i).Type = "submit" And _
           objCollection(i).Name = "" Then

            ' "Search" button is found
            Set objElement = objCollection(i)

        End If
    End If
    i = i + 1

   Wend

   objElement.Click    ' click button to search

End Sub

Upvotes: 1

Related Questions