简体   繁体   中英

how to save a downloaded excel file using vba

I made a simple VBA code that go to a link and download a Excel file, the link is an intermediate HTML page which then downloads the file, i just need to access, but now i need to save it. I am a noob at VBA, can anyone help me? Follow the code Bellow

Private pWebAddress As String

Public Declare PtrSafe Function ShellExecute _
Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Public Sub NewShell(cmdLine As String, lngWindowHndl As Long)
    ShellExecute lngWindowHndl, "open", cmdLine, "", "", 1
End Sub

Public Sub WebPage()
    Let pWebAddress = "https://imea.com.br/imea-site/arquivo-externo?categoria=relatorio-de-mercado&arquivo=cup-milho&numeropublicacao=4"
    
    Call NewShell(pWebAddress, 3)

i Have already researched a lot, but none of the ones i have seen had be of help.


UPDATE With the help of Tim, i sucessfully made the vba code, it was simple.

        Dim wb As Workbook
        
        Set wb = Workbooks.Open("PastTheLinkHere")
        wb.SaveAs "PastTheDestinationHere"
        wb.Close
        
        End Sub

What i really needed was to make the link a direct link, and with help of Tim it was easy. Thank you Tim.

This URL:
https://imea.com.br/imea-site/arquivo-externo?categoria=relatorio-de-mercado&arquivo=cup-milho&numeropublicacao=4

leads to a page with this javascript which builds the final URL:

methods: {
        laodMetadata() {
            const urlParams = new URLSearchParams(window.location.search);
            this.categoria = urlParams.get("categoria");
            this.safra = urlParams.get("safra");
            this.arquivo = urlParams.get("arquivo");
            this.numeropublicacao = urlParams.get("numeropublicacao");
        },
        async loadData() {
            this.loading = true;
            const url = "https://publicacoes.imea.com.br";
            this.url = url;
            if (this.categoria != null)
                this.url = this.url + `/${this.categoria}`;
            if (this.safra != null) this.url = this.url + `/${this.safra}`;
            if (this.arquivo != null) this.url = this.url + `/${this.arquivo}`;
            if (this.numeropublicacao != null)
                this.url = this.url + `/${this.numeropublicacao}`;
            return this.url;
        },

The final URL is then:

https://publicacoes.imea.com.br/relatorio-de-mercado/cup-milho/4

So this works and opens the Excel file directly in Excel:

Workbooks.Open "https://publicacoes.imea.com.br/relatorio-de-mercado/cup-milho/4"

You could translate that js into VBA to make a function which would translate the first URL into the second one.

Function tester()
    Dim url As String
    url = "https://imea.com.br/imea-site/arquivo-externo?" & _
          "categoria=relatorio-de-mercado&arquivo=cup-milho&numeropublicacao=4"
          
    Debug.Print MapToDownloadUrl(url)
End Function

Function MapToDownloadUrl(url As String) As String
    Dim urlNew As String, dict As Object, e
    
    Set dict = ParseQuerystring(url)
    If dict Is Nothing Then Exit Function
    urlNew = "https://publicacoes.imea.com.br"
    For Each e In Array("categoria", "arquivo", "numeropublicacao")
        If dict.exists(e) Then urlNew = urlNew & "/" & dict(e)
    Next e
    MapToDownloadUrl = urlNew
End Function

'Parse out the querystring parameters from a URL as a dictionary
Function ParseQuerystring(url) As Object
    Dim dict As Object, arr, arrQs, e
    arr = Split(url, "?")
    If UBound(arr) > 0 Then
        Set dict = CreateObject("scripting.dictionary")
        dict.comparemode = 1 'case-insensitive
        arrQs = Split(arr(1), "&")
        For Each e In arrQs
            If InStr(e, "=") > 0 Then
                arr = Split(e, "=")
                If UBound(arr) = 1 Then dict.Add arr(0), arr(1)
            End If
        Next e
        Set ParseQuerystring = dict
    End If
End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM