使用VBA从IE下载文件

时间:2016-09-19 22:24:56

标签: javascript excel vba excel-vba

我目前正在开发一个VBA代码,用于检索此网站的顶级文件(http://infopost.bwpmlp.com/Posting/default.aspx?Mode=Display&Id=27&tspid=100000)。我可以在我的代码中使用Javascript单击按钮,我可以在下载开始后单击打开。但是,我在保存文件时遇到问题。因为工作簿是从网站上提取的,所以实际上无法将其设置为我能想到的活动工作簿。目前当我做ActiveWorkbook.Save时,代码正在保存我正在测试代码的空白工作簿。我下载的文件似乎无法打开,直到整个代码完成运行,即使我尝试放入休息。有人有主意吗?我的代码如下。谢谢!

 Option Explicit
Dim ie As InternetExplorer
Dim h As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr


Sub Texas_Gas()
Application.DisplayAlerts = True

Dim ie As Object
Dim IeHandle As Long, FileDownloadHandle As Long, OpenButtonHandle As Long, IePopupBarHandle As Long
Dim AutoMode As Boolean, FileDownloadClassicPopup As Boolean, DownloadComplete As Boolean
Dim Timeout As Date
Dim strSPICE As String, strLink As String
Dim PopupGap As Integer, i As Integer
Set ie = CreateObject("InternetExplorer.Application")

DownloadComplete = False
    FileDownloadClassicPopup = False
    FileDownloadHandle = 0
    IePopupBarHandle = 0


With ie
.Visible = True
.navigate "http://infopost.bwpmlp.com/Posting/default.aspx?    Mode=Display&Id=27&tspid=100000"
    Do While .Busy: DoEvents: Loop
    Do While .readyState <> 4: DoEvents: Loop
End With

ie.document.parentWindow.execScript "javascript:WebForm_DoPostBackWithOptions(new WebForm_PostBackOptions(""dgITMatrix:0:lnkBtnDownload"", """", true, """", """", false, true))"


Dim o As IUIAutomation
Dim e As IUIAutomationElement
Dim iCnd As IUIAutomationCondition
Set o = New CUIAutomation
h = ie.Hwnd
h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)


If h = 0 Then Exit Sub

Set e = o.ElementFromHandle(ByVal h)

Set iCnd = o.CreatePropertyCondition(UIA_NamePropertyId, "Open")

Dim Button As IUIAutomationElement
Set Button = e.FindFirst(TreeScope_Subtree, iCnd)
Dim InvokePattern As IUIAutomationInvokePattern
Set InvokePattern = Button.GetCurrentPattern(UIA_InvokePatternId)
InvokePattern.Invoke


ActiveWorkbook.SaveAs "I:\Cap_Rel\raw_scrapes\Texas_Gas_Transmission\parsed\Texas_Gas_Transmission_CapRel" & Format(Date - 1, "yyyymmdd") & "MACRO", FileFormat:=xlCSV

End Sub

0 个答案:

没有答案