宏来改变日期并在网站上生成电子表格

时间:2013-09-24 18:54:36

标签: excel vba

我经常使用一个网站来生成电子表格。网站上的唯一项目是“开始日期”字段,“结束日期”字段和“开始”按钮。输入我的日期范围并单击“开始”后,它会下载.cfm文件,我点击打开excel,excel警告文件有不同的扩展名并验证它没有损坏我点击打开我有我需要的数据有一个宏可以根据需要进行组合。 我正在寻求自动化步骤:

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

我以前用过从网站获取数据的宏只复制和粘贴特定网址上可见的数据,如下所示。我操纵输入电子表格上的网址来操纵数据。

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

谢谢。

1 个答案:

答案 0 :(得分:1)

以下代码适用于我。您必须根据特定网站如何命名输入框来更改“startDate”和“endDate”。

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