excel - 在 Excel VBA 中使用 WinHttp 检索重定向的 URL

Question

我希望构建一个可以检索重定向 URL 并将其放置在单元格中的子程序。我有一系列包含完成 URL 的数字的单元格。使用 WinHTTP 打开此链接，然后将文件保存为 PDF 格式。返回的页面是一个重定向，每次打开时我都需要拉取 URL 以隔离重要信息。我已经看到显然能够做到这一点但无法让它们工作的函数，而且我对 WinHTTP 几乎没有经验。我试图理解已发布的功能，但到目前为止还无法理解。如果可能的话，我宁愿把它作为一个子函数。任何帮助将不胜感激以下是我能找到的最接近我的要求的东西，但在将其作为子程序运行时遇到了麻烦。

Public Function testRedirect(oCell As Range) As String

 testRedirect = "not redirected"

 strURL = oCell.Hyperlinks(1).Address

 WinHttpRequestOption_EnableRedirects = 6

 Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
 oWinHttp.Option(WinHttpRequestOption_EnableRedirects) = False

 oWinHttp.Open "HEAD", strURL, False
 oWinHttp.send ""

 If oWinHttp.Status = 301 Then
  strResponseHeaders = oWinHttp.getAllResponseHeaders()
  For Each strResponseHeader In Split(strResponseHeaders, Chr(10))
   If Left(strResponseHeader, 9) = "Location:" Then
    testRedirect = "redirected to " & strResponseHeader
   End If
  Next
 End If

End Function

以下代码是我用来请求文件并保存它们的代码，它运行良好，但需要在某处安装上述代码。请原谅格式。我只到了它工作的阶段，还没有时间去打磨它。也可能有不需要的变量等。

Sub Printdrawings()


Dim WB As Workbook
Dim WS As Worksheet
Dim ROWS As Long
Dim IE As Object
Dim LINKS As Variant
Dim LINK As Variant
Dim RNG As Range
Dim URL As String
Dim CLL As Range

Dim FileNum As Long
Dim FileData() As Byte
Dim MyFile As String
Dim WHTTP As Object
Dim FileName As String


Set WB = ThisWorkbook
Set WS = WB.Sheets("Sheet1")

'Calculates the amount of used rows in column A
ROWS = WS.Cells(WS.ROWS.Count, "A").End(xlUp).Row
Debug.Print ROWS

'Sets a range based on the variable counted occupied rows from above
Set RNG = WS.Range("A1:A" & ROWS)

    
   For Each CLL In RNG
    
    On Error Resume Next
        Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
        If Err.Number <> 0 Then
            Set WHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
        End If
    On Error GoTo 0
    
    
    
    MyFile = "http://URLBODY" & CLL
    
    WHTTP.Open "GET", MyFile, False
    WHTTP.Send
    FileData = WHTTP.ResponseBody
    Set WHTTP = Nothing
    
    If Dir("C:\MyDownloads", vbDirectory) = Empty Then MkDir "C:\MyDownloads"
    
    FileName = Right(MyFile, 12)
    Debug.Print FileName
    FileNum = FreeFile
    Open "C:\MyDownloads\" & FileName & ".pdf" For Binary Access Write As #FileNum
        Put #FileNum, 1, FileData
    Close #FileNum
    
    Next CLL
    
    
    MsgBox "Open the folder [ C:\MyDownloads ] for the downloaded file..."


End Sub

标签： excelvbawinhttp