单击 excel 中的超链接，将文件从 .network 驱动器本地服务器下载到文件夹

Question

I have an excel where there are around 30K hyperlinks pointing to a.network drive location where all the files are stored. I am trying to create a macro where when i click on the hyperlink it downloads the file to a folder like 'Downloads' where as right now it is just viewing the file in IE.

Have not much idea on macros but have tried using shell app.browseforfolder, FileCopy and URLDownloadToFile but still getting errors.Also have tried using Selection to download selected cells hyperlinks but no dice.

Sample excel file is here: https://filebin.net/06n8hp1wm8y69oqw

Network drive links are like:

\\10.111.11.30\Accounts\EP-D365\39156.jpg

\\10.111.11.30\Accounts\EP-D365\39157.jpg

\\10.111.11.30\Accounts\EP-D365\39158.msg

I managed to put together below code from online resources but doesnt work as it is for download from inte.net and not.network drive local server:

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 = "\\10.111.11.30\Accounts\EP-D365\39156.jpg"
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, 2
    oStream.Close
End If
''Next
End Sub

Any help appreciated.Thanks.

Answer 1

You can use FileCopy to copy files from a file system - works with UNC pathes. I think your problem comes from the destination - Runtime error 75 is Path/File access error which usually means that the file cannot be written.

I am not 100% sure about all details of FileCopy , but I think you have to give the filename for the destination also - it's different than copy on the command prompt. If you just write the destination folder, you get the error 75 because FileCopy tries to replace the destination folder with the file - which of course doesn't work.

The following code will copy both files from Http and from file system. I did it a little quick&dirty by checking if the path contains a "Slash" or "Backslash" (Mac users will need to find a different attempt). Filename is extracted from the source and glued to the dest folder.

A small advice: Don't hardcode the user path, you can use environ("userprofile") instead.

And one remark: Code will fail if the destination folder does not exist.

Sub test()

    Const source = "\\10.111.11.30\Accounts\EP-D365\39156.jpg"
    Const url = "https://i.stack.imgur.com/WyPLd.png"

    CopyFile source, Environ("TEMP")
    CopyFile url, Environ("TEMP")

End Sub


Sub CopyFile(source As String, destPath As String)

    If InStr(source, "/") > 0 Then
        DownloadFile source, Environ("TEMP")
    Else
        Dim filename As String, p As Integer
        p = InStrRev(source, "\")
        filename = Mid(source, p + 1)
        FileCopy source, destPath & "\" & filename
    End If
End Sub

Sub DownloadFile(url As String, destPath As String)
    
    Dim WinHttpReq As Object
    Dim oStream As Object

    Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
    WinHttpReq.Open "GET", url, False, "", ""
    WinHttpReq.send
    
    Dim filename As String, p As Integer
    p = InStrRev(url, "/")
    filename = Mid(url, p + 1)
    
    If WinHttpReq.Status = 200 Then
        Set oStream = CreateObject("ADODB.Stream")
        oStream.Open
        oStream.Type = 1
        oStream.Write WinHttpReq.responseBody
        oStream.SaveToFile destPath & "\" & filename, 2
        oStream.Close
    End If
End Sub