求VBScript批量读取TXT内URL列表下载访问结果的实现指引

现有代码的核心问题 #

• 代码调用的download函数无任何实现逻辑，运行时会直接抛出「未定义变量」错误，流程完全无法启动
• 输出文件采用相对路径，默认保存在脚本运行的当前工作目录，和项目文件夹不统一，后续文件查找容易混乱
• 无空行过滤逻辑，输入文件里的空行会触发无效请求
• 无异常捕获机制，单个URL访问失败、文件被占用的情况会直接导致整个批处理流程中断
• 未处理响应编码，直接保存文本容易出现乱码

修正后可直接运行的完整代码 #

Option Explicit

Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")

' 输入URL列表的文件路径
Dim inputPath
inputPath = "C:\Users\212708488\Desktop\Project Bacon\Excellist.txt"

' 校验输入文件是否存在
If Not objFSO.FileExists(inputPath) Then
    WScript.Echo "错误：URL列表文件不存在，请检查路径"
    WScript.Quit
End If

' 统一输出目录为输入文件所在的项目文件夹
Dim outputBasePath
outputBasePath = objFSO.GetParentFolderName(inputPath) & "\"

' 打开输入文件（只读模式）
Dim objFile
Set objFile = objFSO.OpenTextFile(inputPath, 1)
Dim FileNumber
FileNumber = 0

' 逐行读取URL列表
Do Until objFile.AtEndOfStream
    Dim URLFromList
    URLFromList = Trim(objFile.ReadLine)
    ' 跳过空行
    If URLFromList <> "" Then
        FileNumber = FileNumber + 1
        Dim saveFullPath
        saveFullPath = outputBasePath & "test" & FileNumber & ".txt"
        
        If DownloadURL(URLFromList, saveFullPath) Then
            WScript.Echo "下载成功：" & URLFromList & " 对应文件test" & FileNumber & ".txt"
        Else
            WScript.Echo "下载失败：" & URLFromList
        End If
    End If
Loop

objFile.Close
Set objFile = Nothing
Set objFSO = Nothing

' 自定义URL下载函数
Function DownloadURL(strTargetURL, strLocalSavePath)
    On Error Resume Next
    DownloadURL = False
    
    ' 初始化WinHTTP请求对象，设置超时防止卡死
    Dim httpReq
    Set httpReq = CreateObject("WinHttp.WinHttpRequest.5.1")
    httpReq.SetTimeouts 5000, 5000, 5000, 5000
    
    ' 发送GET请求
    httpReq.Open "GET", strTargetURL, False
    httpReq.Send
    
    ' 校验请求是否成功返回
    If Err.Number = 0 And httpReq.Status = 200 Then
        ' 用ADODB.Stream处理UTF-8编码，避免保存文件乱码
        Dim streamObj
        Set streamObj = CreateObject("ADODB.Stream")
        streamObj.Mode = 3
        streamObj.Type = 2
        streamObj.Charset = "UTF-8"
        streamObj.Open
        streamObj.WriteText httpReq.ResponseText
        streamObj.SaveToFile strLocalSavePath, 2 ' 2=覆盖已有同名文件
        streamObj.Close
        Set streamObj = Nothing
        
        If Err.Number = 0 Then DownloadURL = True
    End If
    
    Set httpReq = Nothing
    On Error GoTo 0
End Function

落地说明 #

• 生成的编号文本文件（test1.txt、test2.txt…）会和输入的Excellist.txt保存在同一项目目录下，编号顺序和URL列表的行顺序一一对应，可直接和Excel数据做匹配
• 如网络环境需要代理访问外网，可在请求初始化段增加代理配置语句
• 如目标URL需要身份校验（账号、Cookie），可在请求发送前补充对应请求头参数

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