Question

我在Excel工作表上列出了300多个超链接。

我想使用Excel VBA将所有内容从每个链接下载到我的计算机。我正在使用此代码，但是它没有在链接上下载excel文件或pdf文件。

有人可以帮助我吗？

Sub test()

Dim hlink As Hyperlink
Dim wb As Workbook
Dim saveloc As String

saveloc = "C:\Users\"
For Each hlink In ThisWorkbook.Sheets("Main").Hyperlinks
    Set wb = Workbooks.Open(hlink.Address)
    wb.SaveAs saveloc & hlink.Parent & ".xlsx"
    wb.Close True
    Set wb = Nothing
Next

End Sub

和此代码

Sub DownloadFile()
Dim WinHttpReq As Object
Dim oStream As Object
Dim myURL As String
Dim LocalFilePath As String

myURL = "https://"
LocalFilePath = "C:\Users"

Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "", ""  '("username", "password")
WinHttpReq.send

If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile LocalFilePath, 2
    oStream.Close
End If
End Sub

Answer 1

尝试一下： https://www.extendoffice.com/documents/excel/2328-excel-open-multiple-hyperlinks.html

VBA代码：一次打开多个超链接

复制并运行：

Sub OpenHyperLinks()
'Update 20141124
    Dim xHyperlink As Hyperlink
    Dim WorkRng As Range
    On Error Resume Next
    xTitleId = "KutoolsforExcel"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    For Each xHyperlink In WorkRng.Hyperlinks
        xHyperlink.Follow
    Next
End Sub

Answer 2

您发布到DownloadFile()的代码无法正常工作，因为目前它仅调用https://作为URL，而没有其他功能。

由于您没有提供更多信息，因此建议您结合使用两种方法来实际使用excel中提供的URL

Sub DownloadFile()
Dim WinHttpReq As Object
Dim oStream As Object
Dim myURL As String
Dim LocalFilePath As String
For Each hlink In ThisWorkbook.Sheets("Main").Hyperlinks
myURL = hlink 
LocalFilePath = "C:\Users"

Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
WinHttpReq.Open "GET", myURL, False, "", ""  
WinHttpReq.send

If WinHttpReq.Status = 200 Then
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write WinHttpReq.responseBody
    oStream.SaveToFile LocalFilePath + someFileName, 2 'you have to create a unique filename here (maybe split the hlink for something usefull)
    oStream.Close
End If
Next
End Sub

Excel VBA从URL超链接下载文件

2 个答案: