使用VBA上传Excel至SharePoint时未知URL段的通配符匹配问题

首先明确：SharePoint的URL路径不支持通配符匹配，你之前尝试的*、%通配符写法无法被SaveAs方法识别，必须先获取到项目编号对应的完整文件夹名称，再拼接上传路径。

实现思路 #

你可以通过VBA先枚举SharePoint站点下Projects目录的所有子文件夹，匹配名称以当前项目编号开头的文件夹，拿到完整文件夹名后再拼接完整上传路径即可，具体实现可参考如下方案：

1. （可选）在VBA编辑器的「工具-引用」中勾选Microsoft Scripting Runtime和Microsoft XML, v6.0，也可以用后期绑定省去引用步骤，兼容性更强
2. 先获取Projects站点下的所有子文件夹列表
3. 匹配以目标项目编号开头的文件夹
4. 拼接完整路径执行保存

修正后的VBA代码 #

Public Sub CommandButton39_Click()
    Dim projectNo As String
    Dim basePath As String
    Dim endPath As String
    Dim targetFolder As String
    Dim fullSavePath As String
    
    ' 读取单元格中的项目编号
    projectNo = Trim(Range("B2").Value)
    basePath = "https://teamcde.sharepoint.com/sites/Projects/"
    endPath = "/10.%20Dispatch/"
    
    ' 调用自定义函数获取匹配项目编号的文件夹名
    targetFolder = GetMatchProjectFolder(basePath, projectNo)
    
    If targetFolder = "" Then
        MsgBox "未找到对应项目编号的文件夹，请检查项目编号是否正确", vbExclamation
        Exit Sub
    End If
    
    ' 拼接完整保存路径，文件名放在路径最后
    fullSavePath = basePath & targetFolder & endPath & projectNo & ".xlsm"
    
    ' 执行保存，指定xlsm格式避免报错
    ActiveWorkbook.SaveAs Filename:=fullSavePath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

' 匹配对应项目编号的文件夹函数
Function GetMatchProjectFolder(basePath As String, projectNo As String) As String
    Dim fso As Object
    Dim rootFolder As Object
    Dim subFolder As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' 将SharePoint路径转换为可被FSO识别的UNC路径，适配已挂载/同步到本地的SharePoint站点
    Dim uncPath As String
    uncPath = Replace(Replace(basePath, "https://", "\\"), "/", "\")
    
    On Error Resume Next
    Set rootFolder = fso.GetFolder(uncPath)
    If Err.Number <> 0 Then
        Err.Clear
        GetMatchProjectFolder = ""
        Exit Function
    End If
    On Error GoTo 0
    
    ' 遍历所有子文件夹匹配前缀
    For Each subFolder In rootFolder.SubFolders
        If Left(Trim(subFolder.Name), Len(projectNo)) = projectNo Then
            ' 编码空格为URL可识别的格式
            GetMatchProjectFolder = Replace(subFolder.Name, " ", "%20")
            Exit Function
        End If
    Next
    
    GetMatchProjectFolder = ""
End Function

注意事项 #

• 如果你的SharePoint没有同步到本地文件管理器，可将上面的文件夹枚举逻辑替换为调用SharePoint REST API的/_api/web/folders接口获取文件夹列表，匹配规则不变
• 原代码中的变量名错误（定义了ProjectFileName但使用了未定义的ThisFile）已修正

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