Excel文件保存至Sharepoint失败：VBA代码路径拼接问题排查

使用VBA将文件保存至Sharepoint时出现错误，本地路径下代码可正常运行，但文件位于Sharepoint环境时，即使手动将路径中的空格替换为%20，拼接后的路径仍无法正常保存——仅当直接赋值完整Sharepoint路径时能成功执行。

错误代码片段 #

Dim fso As Object
Dim template As Workbook
Dim TempPath As String  'path is set with folder picker

Set fso = CreateObject("Scripting.FileSystemObject")
currentname = fso.GetBaseName(ThisWorkbook.Name)

Set template = Workbooks.Open(TempPath)
DoEvents

If InStr(ThisWorkbook.Path, "/") > 0 Then 'check if it's saving to Sharepoint
urlpath = Replace(ThisWorkbook.Path, " ", "%20")
urlname = Replace(currentname, " ", "%20")
Savename = urlpath & "/" & urlname & "_New" & ".xlsm"
Else
Savename = ThisWorkbook.Path & "\" & currentname & "_New" & ".xlsm"
End If

currentformat = template.FileFormat
template.SaveAs Filename:=Savename, FileFormat:=currentformat

关键现象 #

• 本地文件库下代码执行无异常
• Sharepoint环境中ThisWorkbook.Path返回带空格的路径，替换为%20后拼接的路径与录制宏生成的格式完全一致，但保存报错
• 直接赋值完整Sharepoint路径（如https://companyname.sharepoint.com/sites/team_data/Shared%20Documents/folder%20location/filename_New.xlsm）时，保存操作成功

方案1：用URLEncode函数完整编码文件名 #

手动替换空格为%20无法覆盖所有特殊字符编码场景，通过URLEncode函数处理文件名部分更可靠：

先添加编码函数：

Private Function URLEncode(ByVal StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
    Dim StringLen As Long: StringLen = Len(StringVal)
    If StringLen > 0 Then
        ReDim result(StringLen) As String
        Dim i As Long, CharCode As Integer
        Dim Char As String, SpaceReplacer As String
        
        SpaceReplacer = IIf(SpaceAsPlus, "+", "%20")
        
        For i = 1 To StringLen
            Char = Mid$(StringVal, i, 1)
            CharCode = Asc(Char)
            Select Case CharCode
                Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
                    result(i) = Char
                Case 32
                    result(i) = SpaceReplacer
                Case Else
                    result(i) = "%" & Right$("0" & Hex$(CharCode), 2)
            End Select
        Next i
        URLEncode = Join(result, "")
    End If
End Function

再修改路径拼接逻辑：

If InStr(ThisWorkbook.Path, "/") > 0 Then
    Dim encodedFileName As String
    encodedFileName = URLEncode(currentname & "_New.xlsm")
    ' 确保路径末尾带斜杠
    Savename = ThisWorkbook.Path & IIf(Right(ThisWorkbook.Path, 1) = "/", "", "/") & encodedFileName
Else
    Savename = ThisWorkbook.Path & "\" & currentname & "_New.xlsm"
End If

方案2：映射Sharepoint为网络驱动器 #

将Sharepoint文档库映射为本地网络驱动器，用本地路径逻辑保存，无需处理URL编码：

1. 在Windows中添加映射网络驱动器，路径填写Sharepoint文档库的网络路径（如\\companyname.sharepoint.com@SSL\DavWWWRoot\sites\team_data\Shared Documents）
2. 修改代码，直接用映射驱动器路径拼接保存路径，与本地保存逻辑一致

方案3：补全路径末尾的斜杠 #

ThisWorkbook.Path末尾若缺少斜杠，会导致拼接后的路径格式错误（如https://xxx.com/folderfilename.xlsm），补充斜杠即可修复：

If InStr(ThisWorkbook.Path, "/") > 0 Then
    urlpath = ThisWorkbook.Path
    If Right(urlpath, 1) <> "/" Then urlpath = urlpath & "/"
    urlname = Replace(currentname & "_New.xlsm", " ", "%20")
    Savename = urlpath & urlname
Else
    Savename = ThisWorkbook.Path & "\" & currentname & "_New.xlsm"
End If

方案4：尝试用SaveCopyAs替代SaveAs #

若SaveAs仍有异常，可先保存副本再调整格式：

template.SaveCopyAs Filename:=Savename
' 重新打开确保格式正确
Dim tempWB As Workbook
Set tempWB = Workbooks.Open(Savename)
tempWB.SaveAs Filename:=Savename, FileFormat:=currentformat
tempWB.Close SaveChanges:=False

内容的提问来源于stack exchange，提问作者M. Isaacs