在網站上更改日期和生成電子表格的宏

有一個我經常用來生成電子表格的網站。網站上唯一的項目是「開始日期」字段，「結束日期」字段和「開始」按鈕。進入我的日期範圍後點擊「Go」下載一個.cfm文件，點擊excel打開，excel警告文件有一個不同的擴展名，並驗證它沒有損壞，我點擊打開，我有我需要的數據和從根據需要有一個宏來製作。我希望自動化的步驟：在網站上更改日期和生成電子表格的宏

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

我以前用來從一個網站只複製和粘貼數據在特定的URL可見的數據，是如下的宏。我操縱輸入電子表格中的網址來操縱數據。

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

謝謝。

來源

2013-09-24 rcm19

如果你分享我可以試用的URL。 – Santosh

該網站在工作中受保護的服務器上。類似的問題網站可能會在航空公司的網站上更改出發日期和返航日期並進行搜索（儘管它不下載文件，並且航空公司網站上有很多額外的項目和字段）。我希望它是一個公共URL。 – rcm19

This [link]（http://stackoverflow.com/questions/15959008/import-web-data-in-excel-using-vba/15962055#15962055）可能會有幫助。 – Santosh

以下代碼適用於我。您必須根據具體網站如何命名輸入框來更改「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

來源

2013-10-01 17:41:31 mr261

在網站上更改日期和生成電子表格的宏

回答

相關問題