VBA文件夹创建代码在SharePoint环境运行报错如何解决

问题原因 #

VBA 内置的 Dir、MkDir 函数仅支持 Windows 本地文件系统路径（含标准磁盘路径、UNC 路径），当工作簿保存在 SharePoint 环境时，ActiveWorkbook.Path 会返回 https:// 开头的 Web URL 格式路径，本地文件操作函数无法识别该格式，因此触发运行时错误 52。使用 Application.PathSeparator 仅能解决路径分隔符的问题，无法解决路径格式不兼容的核心问题。

解决方案 #

通过路径格式转换 + 改用 Scripting.FileSystemObject 完成文件夹操作，可同时兼容本地 Windows 与 SharePoint 环境，无需提前映射磁盘，直接通过 WebDAV 格式的 UNC 路径操作文件夹即可。

完整修改后代码（后期绑定版本，无需提前添加引用） #

Sub Setup()
    Dim sFilePath As String
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 获取工作簿路径校验
    sFilePath = ActiveWorkbook.Path
    If sFilePath = "" Then
        MsgBox "工作簿未保存，无法获取路径"
        Exit Sub
    End If
    
    ' 转换SharePoint URL为WebDAV UNC路径
    If LCase(Left(sFilePath, 8)) = "https://" Then
        sFilePath = Replace(sFilePath, "https://", "\\")
        sFilePath = Replace(sFilePath, "/", "\")
        ' 插入WebDAV标识
        Dim firstSlashPos As Long
        firstSlashPos = InStr(3, sFilePath, "\")
        If firstSlashPos > 0 Then
            sFilePath = Left(sFilePath, firstSlashPos) & "@SSL\DavWWWRoot" & Mid(sFilePath, firstSlashPos)
        End If
    End If
    
    ' 统一定义要创建的文件夹列表
    Dim folderNames As Variant
    folderNames = Array("Survey forms to go", "Survey forms to import", "Archived Survey forms")
    
    Dim folderName As Variant
    Dim fullFolderPath As String
    For Each folderName In folderNames
        fullFolderPath = fso.BuildPath(sFilePath, folderName)
        ' 检查文件夹是否存在，不存在则创建
        If Not fso.FolderExists(fullFolderPath) Then
            fso.CreateFolder fullFolderPath
        End If
    Next
    
    Set fso = Nothing
    MsgBox "文件夹检查/创建完成"
End Sub

注意事项 #

• 代码自动适配本地和SharePoint环境，无需针对不同环境写两套逻辑
• fso.BuildPath会自动处理不同环境的路径分隔符，不需要手动拼接分隔符
• 如果运行时依然报错无法访问路径，按Win+R输入services.msc，找到WebClient服务设置为自动启动并启动该服务即可，WebDAV访问依赖该服务支持。

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