URLDownloadToFile无法正常工作

时间:2018-05-12 15:04:38

标签: excel vba excel-vba

URLDownloadToFile会自动将文件下载到缓存而不是特定路径

示例:

URLDownloadToFile正在下载文件到缓存路径C:\Users\38100442\AppData\Local\Microsoft\Windows\INetCache\IE\KUQPK734而不是特定路径D:\example\filename.pdf。我希望所有文件都在D:\example\filename.pdf下载。

请参阅以下代码

Private Declare Function URLDownloadToFile Lib "urlmon" _
                         Alias "URLDownloadToFileA" ( _
                         ByVal pCaller As Long, _
                         ByVal szURL As String, _
                         ByVal szFileName As String, _
                         ByVal dwReserved As Long, _
                         ByVal lpfnCB As Long _
                         ) As Long

Public IE As Object

Sub workflow()

    Set wb = ThisWorkbook.Sheets("Macro")
    lstrw = wb.Cells(Rows.Count, 1).End(xlUp).Row
    strDest = Sheets("Macro").TextBox1.Text
    If Trim(LCase(strDest)) = "false" Or Trim(strDest) = "" Then
        MsgBox "Please select the Output Folder", vbCritical
        Exit Sub
    End If
    Set IE = New InternetExplorerMedium

    IE.Visible = True
    Application.wait (Now + #12:00:03 AM#)
    IE.navigate "http://172.20.41.73:7003/taskspace/component/main/?appname=coe"

    wait
    'While IE.document.ReadyState <> "complete": DoEvents: Wend
IE.document.getElementById("LoginUsername").Value = "38100562"
IE.document.getElementById("LoginPassword").Value = "!Redsba05%"
IE.document.getElementsByName("ImgMgrLogin_loginButton_0")(0).Click
wait
Set ieAnchors = IE.document.getElementsByName("RoleSelector_rolesList_0")(0)

For Each Anchor In ieAnchors
    DoEvents
    If Anchor.innerHTML = "finance_role" Then
        Anchor.Selected = True
        IE.document.getElementsByName("RoleSelector_rolesSubmitButton_0")(0).Click
        Exit For
    End If
Next Anchor
wait
i0 = 0
i1 = 1

wait
wait
For i = 2 To lstrw
    DoEvents
    If Trim(LCase(Range("b" & i).Value)) = "" Then
        casID_val = Trim(wb.Range("A" & i).Value)
upline:
        On Error Resume Next
upline2:
        'While IE.document.frames.Item(2).document.ReadyState <> "complete": DoEvents: Wend
    Set ieAnchors = IE.document.frames.Item(2).document.getElementsByTagName("a")
    If ieAnchors Is Nothing Then GoTo upline
    For Each Anchor In ieAnchors
        DoEvents
        If Anchor.Name = "NavigationbarComponent_NavigationbarComponent_tabsImgMgrNav_FinanceSearch_close_0" Then
            Anchor.Click
        End If
    Next Anchor
    wait
    'While IE.document.frames.Item(3).document.frames.Item(1).document.ReadyState <> "complete": DoEvents: Wend

Set caseID = Nothing
Set caseID = IE.document.frames.Item(3).document.frames.Item(1).document.getElementById("body_body_body_xform1_object_name_0_value_0_0")
If caseID Is Nothing Then GoTo upline2


caseID.Value = casID_val
IE.document.frames.Item(3).document.frames.Item(1).document.getElementsByName("body_body_body_xform1_search_trigger_0_value_0_0")(0).Click
wait
'While IE.document.frames.Item(3).document.frames.Item(1).document.ReadyState <> "complete": DoEvents: Wend

Set openItem = IE.document.frames.Item(3).document.frames.Item(1).document.getElementsByTagName("tr")
If Trim(openItem(40).innerText) <> "No items" Then
openItem(40).FireEvent "ondblclick", 1, 2
wait
'While IE.document.frames.Item(3).document.frames.Item(1).document.frames.document.frames.Item(1).document.ReadyState <> "complete": DoEvents: Wend
dataGrid_id = ""
Set data_item = IE.document.frames.Item(3).document.frames.Item(1).document.frames.document.frames.Item(1).document.getElementById("FolderContentViewComponent___XFORMS_FOLDERCONTENT_DATAGRID_CONTROL_NAME_0_data")
For Each data_item_innertext In data_item.getElementsByTagName("tr")
DoEvents
If InStr(LCase(data_item_innertext.innerText), "pdf") > 0 Then
    dataGrid_id = data_item_innertext.ID
    Exit For
End If
Next
If dataGrid_id = "" Then
wb.Range("b" & i).Value = "Not Download"
Set close_tab = IE.document.frames.Item(2).document.getElementById("tab_NavigationbarComponent_openItemTab_" & i0 & "_0").getElementsByTagName("a")
For Each cls In close_tab
    DoEvents
    cls.FireEvent "onclick"
Next cls
wait
'While IE.document.frames.Item(3).document.frames.Item(1).document.frames.document.frames.Item(1).document.ReadyState <> "complete": DoEvents: Wend
i0 = i0 + 1
i1 = i1 + 1
GoTo nxt_loop
End If
Set pdf_pth = IE.document.frames.Item(3).document.frames.Item(1).document.frames.document.frames.Item(1).document.getElementById(dataGrid_id)
pdf_pth.FireEvent "ondblclick", 1, 2
wait
'While IE.document.frames.Item(3).document.frames.Item(1).document.ReadyState <> "complete": DoEvents: Wend
pdf_path_URL = ""
Set pdfIframe = IE.document.frames.Item(3).document.frames.Item(1).document.getElementsByTagName("iFrame")
For Each pdf_scr In pdfIframe
DoEvents
If pdf_scr.Name = "docview_contents_docview_contents_docview_contents_xform1_ImageViewer_0_value_0_0" Then
pdf_path_URL = pdf_scr.src
Exit For
End If
Next pdf_scr
pdf_filename = ""
pdf_filename = Trim(IE.document.frames.Item(2).document.getElementById("tab_NavigationbarComponent_openItemTab_" & i1 & "_0").innerText)

URLDownloadToFile 0, pdf_path_URL, strDest & casID_val & "_" & pdf_filename, 0, 0
Set close_tab = IE.document.frames.Item(2).document.getElementById("tab_NavigationbarComponent_openItemTab_" & i1 & "_0").getElementsByTagName("a")
For Each cls In close_tab
DoEvents
cls.FireEvent "onclick"
Next cls
wait
'While IE.document.frames.Item(2).document.ReadyState <> "complete": DoEvents: Wend
Set close_tab = IE.document.frames.Item(2).document.getElementById("tab_NavigationbarComponent_openItemTab_" & i0 & "_0").getElementsByTagName("a")
For Each cls In close_tab
DoEvents
cls.FireEvent "onclick"
Next cls
wait
i0 = i0 + 2
i1 = i1 + 2
wb.Range("b" & i).Value = "Download"
wb.Range("c" & i).Value = casID_val & "_" & pdf_filename
Else
wb.Range("b" & i).Value = "No Items"
End If
nxt_loop:
ThisWorkbook.Save
End If

Next i
IE.Quit
Set IE = Nothing
MsgBox "Process Complete", vbInformation

End Sub

Function wait()
    Application.wait (Now + #12:00:03 AM#)
    While IE.Busy
        DoEvents
    Wend
    While IE.document.ReadyState <> "complete": DoEvents: Wend
End Function

0 个答案:

没有答案