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