Cant Save Downloaded File to Chosen Location

shilos_dad

New Member
Joined
Mar 20, 2019
Messages
8
i have the following code below..im trying to auto download a file from web then save it to a specific location..however the last part of my code doesnt work.. i highlighted it in RED. thanks.


Code:
Sub Downloadfile()
    Dim ie As Object
    Dim TempFileName As String
    Dim ProfileID As String
    Dim wbPath As String
    Dim objXML As Object: Set objXML = CreateObject("MSXML2.XMLHTTP")
    Dim ostream As Object: Set ostream = CreateObject("ADODB.Stream")
    Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
    Set ie = CreateObject("InternetExplorer.Application")
    Set oShell = CreateObject("Shell.Application")

    wbPath = Application.ActiveWorkbook.Path
    TempFileName = wbPath & "\Run Validation Report.xlsx"
    ThisWorkbook.Activate

    ProfileID = Worksheets("Profile").Range("B2")

    Application.ScreenUpdating = True

    'Open CDP Validation Site
    ie.Visible = True
    ie.Toolbar = 0
    With ie
        Hwnd = .Hwnd
        .navigate "https://test.com"
    End With

    For Each Wnd In oShell.Windows
        If Hwnd = Wnd.Hwnd Then Set ie = Wnd

    Next

    'Click the option for Report Type

    On Error Resume Next
    'ie.document.getElementById("ReportViewerControl_ctl05_ctl04_ctl00_ButtonLink").Click

    'Application.Wait (Now + TimeValue("00:00:15"))
    'Download the report as excel
    Application.Wait (Now + TimeValue("00:00:30"))
    objXML.Open "GET", ie.document.parentWindow.execScript("$find('ReportViewerControl').exportReport('EXCELOPENXML');")

    Application.Wait (Now + TimeValue("00:00:30"))

    Dim o As IUIAutomation
    Dim e As IUIAutomationElement
    Set o = New CUIAutomation
    Dim h As Long
    h = ie.Hwnd
    h = FindWindowEx(h, 0, "Frame Notification Bar", vbNullString)
    If h = 0 Then Exit Sub

    Set e = o.ElementFromHandle(ByVal h)
    Dim iCnd As IUIAutomationCondition
    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

    Application.Wait (Now + TimeValue("00:00:30"))
    ie.Quit

    Application.Wait (Now + TimeValue("00:00:30"))

[COLOR=#ff0000]    'Workbooks("Report.xlsx").Activate

    Application.ActiveProtectedViewWindow.Edit
    ActiveWorkbook.SaveAs strFilename, FileFormat:=".xlsm"[/COLOR]

End Sub
 
Last edited by a moderator:

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
i have the following code below..im trying to auto download a file from web then save it to a specific location..however the last part of my code doesnt work.. i highlighted it in RED. thanks.

Where have you opened the file?

I don't know much about webscraping but as for downloading excel files and opening them hopefully the following function will be useful.

Code:
Public Function Get_File(FileURL As String, SaveFilePathAndName As String)
Dim oStrm As Object, WinHttpReq As Object, Extension As String, File_Name As String
    
Set WinHttpReq = CreateObject("Msxml2.ServerXMLHTTP")
    WinHttpReq.Open "GET", FileURL, False
    WinHttpReq.send
    File = WinHttpReq.responseBody
        If WinHttpReq.Status = 200 Then
            Set oStrm = CreateObject("ADODB.Stream")
            With oStrm
                .Open
                .Type = 1
                .Write WinHttpReq.responseBody
                .SaveToFile SaveFilePathAndName, 2 ' 1 = no overwrite, 2 = overwrite
                .Close
            End With
        End If
End Function
If the file needs to be opened use this
Code:
Public Function Open_File(File_Name_And_Path as string) 'Open file

Dim WBOpen As Workbook

    Set WBOpen = Workbooks.Open(File_Name_And_Path)      'Opens the Excel file/csv

    WBOpen.Windows(1).Visible = False            'Files will not be visible

End Function
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,887
Messages
6,175,199
Members
452,617
Latest member
Narendra Babu D

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top