Excel VBA创建文件夹触发运行时错误'52'（文件名或编号错误）求助

问题诊断 #

Run-time Error '52' 本质是VBA无法识别指定的文件路径或文件名，结合你的代码与客户的特殊路径（含空格、丹麦语字符的长路径），核心诱因包括：

• 手动拼接路径时出现重复反斜杠（如C:\Users\...\\pb.zip）
• Shell.Application.Namespace对含特殊字符的长路径兼容性不足
• 未显式定义ForReading等文件操作常量，依赖环境默认值引发隐式错误
• 关键步骤（解压、文件读取）缺少路径有效性检查

修复方案与代码优化 #

以下是修正后的完整代码，针对上述问题逐一修复：

Option Explicit

' 显式定义文件操作常量，避免环境依赖
Const ForReading = 1

Function versionIsOutdated(strDir As String, strPath As String) As Boolean
    Dim FSO As FileSystemObject
    Dim FileToRead As Object
    Dim TextString As String
    Dim targetPath As String
    Dim remoteVersion As String
    
    Set FSO = New FileSystemObject
    ' 用BuildPath自动处理路径分隔符
    targetPath = FSO.BuildPath(strPath, strDir)
    
    If FSO.FolderExists(targetPath) Then
        ' 获取远程版本号
        remoteVersion = GetRemoteVersion()
        
        ' 验证本地版本文件是否存在
        Dim versionFilePath As String
        versionFilePath = FSO.BuildPath(targetPath, "pb_integration-main\version.txt")
        If FSO.FileExists(versionFilePath) Then
            Set FileToRead = FSO.OpenTextFile(versionFilePath, ForReading)
            TextString = FileToRead.ReadAll
            FileToRead.Close
            
            Debug.Print "本地版本: " & TextString
            Debug.Print "远程版本: " & remoteVersion
            
            ' 版本对比（忽略换行/空格）
            versionIsOutdated = (Trim(TextString) <> Trim(remoteVersion))
            Debug.Print IIf(versionIsOutdated, "版本已过期", "版本最新")
        Else
            versionIsOutdated = True
            Debug.Print "本地版本文件不存在，判定为过期"
        End If
    Else
        versionIsOutdated = True
        Debug.Print "目标文件夹未下载，判定为过期"
    End If
    
    Set FSO = Nothing
End Function

Function GetRemoteVersion() As String
    Dim objXmlHttpReq As Object
    Set objXmlHttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    
    On Error Resume Next
    objXmlHttpReq.Open "GET", "https://raw.githubusercontent.com/Securelife-A-S/pb_integration/main/version.txt", False
    objXmlHttpReq.send
    If Err.Number = 0 And objXmlHttpReq.Status = 200 Then
        GetRemoteVersion = objXmlHttpReq.responseText
    Else
        GetRemoteVersion = ""
        Debug.Print "获取远程版本失败: " & Err.Description
    End If
    On Error GoTo 0
    
    Set objXmlHttpReq = Nothing
End Function

Sub MkDir(strDir As String, strPath As String)
    Dim FSO As FileSystemObject
    Dim targetPath As String
    
    Set FSO = New FileSystemObject
    targetPath = FSO.BuildPath(strPath, strDir)
    
    If FSO.FolderExists(targetPath) Then
        FSO.DeleteFolder targetPath, True
        Debug.Print "已删除旧文件夹: " & targetPath
    End If
    
    If Not FSO.FolderExists(targetPath) Then
        FSO.CreateFolder targetPath
        Debug.Print "已创建新文件夹: " & targetPath
    End If
    
    Set FSO = Nothing
End Sub

Sub downloadAndUnzip()
    Dim FSO As FileSystemObject
    Dim objXmlHttpReq As Object
    Dim objStream As Object
    Dim zipFilePath As String
    Dim extractPath As String
    
    Set FSO = New FileSystemObject
    zipFilePath = FSO.BuildPath(ThisWorkbook.Path, "pb.zip")
    extractPath = FSO.BuildPath(ThisWorkbook.Path, "pb")
    
    ' 下载ZIP文件
    Set objXmlHttpReq = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    objXmlHttpReq.Open "GET", "https://github.com/Securelife-A-S/pb_integration/archive/refs/heads/main.zip", False
    objXmlHttpReq.send
    
    If objXmlHttpReq.Status = 200 Then
        Set objStream = CreateObject("ADODB.Stream")
        objStream.Open
        objStream.Type = 1
        objStream.Write objXmlHttpReq.responseBody
        objStream.SaveToFile zipFilePath, 2 ' 2=覆盖已有文件
        objStream.Close
        Debug.Print "ZIP文件下载完成: " & zipFilePath
    Else
        Debug.Print "ZIP下载失败，状态码: " & objXmlHttpReq.Status
        Exit Sub
    End If
    
    ' 用ZipFile对象解压（兼容性更好）
    Dim zipFile As Object
    Set zipFile = CreateObject("Shell.Application")
    
    ' 验证解压路径和ZIP文件存在
    If FSO.FileExists(zipFilePath) And FSO.FolderExists(extractPath) Then
        ' 静默解压（0=不显示进度，16=覆盖文件）
        zipFile.Namespace(extractPath).CopyHere zipFile.Namespace(zipFilePath).Items, 16
        ' 等待解压完成（Shell操作是异步的，添加延迟）
        DoEvents
        Application.Wait Now + TimeValue("00:00:02")
        Debug.Print "解压完成至: " & extractPath
    Else
        Debug.Print "ZIP文件或解压路径不存在"
    End If
    
    ' 删除临时ZIP文件
    If FSO.FileExists(zipFilePath) Then
        FSO.DeleteFile zipFilePath, True
        Debug.Print "已删除临时ZIP文件"
    End If
    
    Set FSO = Nothing
    Set objXmlHttpReq = Nothing
    Set objStream = Nothing
    Set zipFile = Nothing
End Sub

Sub DeleteVBComponent()
    Dim vbCom As Object
    Const CompName As String = "Main"
    
    On Error Resume Next
    Set vbCom = Application.VBE.ActiveVBProject.VBComponents
    vbCom.Remove VBComponent:=vbCom.Item(CompName)
    If Err.Number <> 0 Then
        Debug.Print "删除组件失败: " & Err.Description
    Else
        Debug.Print "已删除组件: " & CompName
    End If
    On Error GoTo 0
End Sub

Sub addBasFile()
    Dim FSO As FileSystemObject
    Dim basFilePath As String
    
    Set FSO = New FileSystemObject
    basFilePath = FSO.BuildPath(ThisWorkbook.Path, "pb\pb_integration-main\Main.bas")
    
    If FSO.FileExists(basFilePath) Then
        Dim objModule As Object
        Set objModule = Application.VBE.ActiveVBProject.VBComponents.Import(basFilePath)
        objModule.Name = "Main"
        Debug.Print "已导入组件: " & basFilePath
    Else
        Debug.Print "BAS文件不存在: " & basFilePath
    End If
    
    Set FSO = Nothing
End Sub

Sub Workbook_Open()
    Dim isOutdated As Boolean
    
    ' 验证工作簿已保存（避免ThisWorkbook.Path为空）
    If ThisWorkbook.Path = "" Then
        MsgBox "请先保存工作簿后再运行！"
        Exit Sub
    End If
    
    isOutdated = versionIsOutdated("pb", ThisWorkbook.Path & "\")
    If isOutdated Then
        MsgBox "Der er kommet ny version - Downloading påbegyndt"
        MkDir "pb", ThisWorkbook.Path & "\"
        downloadAndUnzip
        DeleteVBComponent
        addBasFile
        ' 验证Main模块存在后再运行
        On Error Resume Next
        Application.Run "Main.init"
        If Err.Number <> 0 Then
            MsgBox "初始化失败: " & Err.Description
        End If
        On Error GoTo 0
    End If
End Sub

关键修复说明 #

• 路径拼接：全部改用FSO.BuildPath，自动处理反斜杠，避免重复分隔符问题。
• 解压兼容性：保留Shell.Application但添加了路径验证与延迟等待，解决异步解压的时序问题；同时增加了文件存在性检查，避免无效路径触发Error 52。
• 常量定义：显式声明ForReading，消除环境依赖。
• 错误处理：在远程版本获取、组件操作、初始化步骤添加错误捕获，避免崩溃。
• 工作簿验证：Workbook_Open中先检查工作簿是否已保存，防止ThisWorkbook.Path为空导致路径无效。

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