VBA代码保存在本地并上传到Sharepoint

Question

我正在尝试生成一个代码，允许我将 activeworkbook 保存在本地 PC 路径中，然后将相同的“.xlsm”文件上传到共享点。我已经尝试了几个小时但没有运气。我的代码会告诉我上传成功，但文件实际上并未上传到 SharePoint。它仅保存在我的本地路径中。请在下面找到我的代码，有什么建议吗？

这是迄今为止的细分：

Sub SaveWorkbookToLocalAndSharePoint()
    Dim wb As Workbook
    Dim localPath As String
    Dim fileName As String
    Dim todayDate As String
    Dim tempFilePath As String
    Dim http As Object
    Dim sharePointPath As String
    Dim boundary As String
    Dim requestBody As String
    Dim fileContent As String
    Dim fileData() As Byte
    
    ' Set workbook
    Set wb = ActiveWorkbook
    
    ' Get today's date in YYYYMMDD format
    todayDate = Format(Date, "YYYYMMDD")
    
    ' Create file name
    fileName = "DepoTest_" & todayDate & ".xlsm"
    
    ' Define paths
    localPath = "C:\YourLocalFolder\" & fileName  ' Change this to your local path
    sharePointPath = "https://yourcompany.sharepoint.com/sites/yoursite/Shared%20Documents/" & fileName  ' Change this to your SharePoint path
    sharePointPath = Replace(sharePointPath, " ", "%20")
    
    ' Save to local path
    On Error GoTo SaveLocalError
    Application.DisplayAlerts = False
    wb.SaveAs Filename:=localPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True
    
    ' Save a copy to the temporary path
    tempFilePath = Environ("TEMP") & "\" & fileName
    wb.SaveCopyAs tempFilePath
    
    ' Read the file content
    fileData = ReadBinaryFile(tempFilePath)
    
    ' Create HTTP request to upload file to SharePoint
    boundary = "----WebKitFormBoundary" & Format(Timer, "0")
    requestBody = "--" & boundary & vbCrLf & _
                  "Content-Disposition: form-data; name=""file""; filename=""" & fileName & """" & vbCrLf & _
                  "Content-Type: application/vnd.ms-excel.sheet.macroEnabled.12" & vbCrLf & vbCrLf & _
                  StrConv(fileData, vbUnicode) & vbCrLf & _
                  "--" & boundary & "--"
    
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "POST", sharePointPath, False
    http.setRequestHeader "Content-Type", "multipart/form-data; boundary=" & boundary
    http.Send requestBody
    
    If http.Status = 200 Or http.Status = 201 Then
        MsgBox "Workbook saved locally and to SharePoint successfully!"
    Else
        MsgBox "Failed to upload to SharePoint. Status: " & http.Status & " " & http.StatusText
    End If
    
    ' Delete the temporary file
    On Error Resume Next
    Kill tempFilePath
    On Error GoTo 0
    
    Exit Sub

SaveLocalError:
    Application.DisplayAlerts = True
    MsgBox "An error occurred while saving the workbook to the local path: " & Err.Description
    Exit Sub
End Sub

Function ReadBinaryFile(filePath As String) As Byte()
    Dim fileNumber As Integer
    Dim fileLength As Long
    Dim fileData() As Byte
    
    fileNumber = FreeFile
    Open filePath For Binary As #fileNumber
    fileLength = LOF(fileNumber)
    ReDim fileData(1 To fileLength)
    Get #fileNumber, , fileData
    Close #fileNumber
    
    ReadBinaryFile = fileData
End Function

Answer 1

感谢大家的回复。我的问题似乎与 OneDrive/Sharepoint 有关。因此，作为一种替代解决方案，我不确定它是否是最好的，但它对我有用，我最终将 Sharepoint/OneDrive 位置映射为网络驱动器，然后我能够使用以下命令直接保存到网络驱动器代码如下。我希望它对其他人有帮助。

Sub SaveWorkbookToMappedDrive()
Dim wb As Workbook
Dim networkPath As String
Dim fileName As String
Dim todayDate As String

' Set workbook
Set wb = ThisWorkbook

' Get today's date in YYYYMMDD format
todayDate = Format(Date, "YYYYMMDD")

' Create file name
fileName = "DepoTest_" & todayDate & ".xlsm"

' Define network path
networkPath = "Z:\" & fileName  ' Change Z: to your mapped drive letter

' Save directly to the network path
On Error GoTo SaveError
Application.DisplayAlerts = False
wb.SaveAs Filename:=networkPath, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True
MsgBox "Workbook saved to network drive successfully!"
Exit Sub

保存错误： 应用程序.DisplayAlerts = True MsgBox“将工作簿保存到网络驱动器时发生错误：”＆Err.Description 退出子程序 结束子