locked
URLDOWNLOADTOFILE is not working properly RRS feed

  • Question

  • URLDOWNLOADTOFILE is automatically downloading files to cache instead of specific path

    Example:

    URLDOWNLOADTOFILE is downloading files to cache path("C:\Users\38100442\AppData\Local\Microsoft\Windows\INetCache\IE\KUQPK734") instead of specific path("D:\example\filename.pdf"). I want all the files to be downloaded in ("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

    Saturday, May 12, 2018 3:26 PM

All replies

  • Hello Thanis Albert Cruz,

    This forum(Excel for Developers) is for development issues related to Excel Object Model and URLDOWNLOADTOFILE is a function of Urlmon.dll. I think your issue is more related to Visual Basic Application, so I would move the thread to Visual Basic for Applications (VBA) forum. Thanks for understanding.

    Best Regards,

    Terry


    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

    Monday, May 14, 2018 1:53 AM