html 如何使用vba保存下载的excel文件

我做了一个简单的VBA代码，去一个链接，并下载一个Excel文件，链接是一个中间的HTML页面，然后下载文件，我只需要访问，但现在我需要保存它。我是一个noob在VBA，有人能帮助我吗？

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)

我已经研究了很多，但是我见过的都没有帮助。

此网址：
https://imea.com.br/imea-site/arquivo-externo?categoria=relatorio-de-mercado&arquivo=cup-milho&numeropublicacao=4
会指向一个包含以下javascript的页面，该javascript构建了最终的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;
        },

最终URL为：
https://publicacoes.imea.com.br/relatorio-de-mercado/cup-milho/4
这样就可以直接在Excel中打开Excel文件：

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

您可以将该js转换为VBA，以创建一个函数，将第一个URL转换为第二个URL。

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

html 如何使用vba保存下载的excel文件

1条答案

相关问题

热门标签

最新问答