将文件上传到 SharePoint，不使用 UNC 或驱动器映射

Question

我正在尝试在 Excel 内使用 VBA 将文件上传到 SharePoint。

我找到了一些解决文件下载问题的 urlmon 代码。

我看到过使用 UNC、winhttp POST 和 SEND 以及 SP SDK 专注于 Scripting.FileSystemObject 的代码，但由于站点和软件的原因，我无法使后者工作安装限制。

我需要直接上传，例如到“http://example.com/foldername”。我尝试将 Scripting.FileSystemObject 与 URL 一起使用。

我大胆假设，除了 UNC 和 winhttp POST/SEND 之外，还有一种 VBA 方法可以将文件上传到 SharePoint。

我试过的代码，是从其他人在 Stack Overflow 上的工作中复制的。

Public Function UploadEICRs(ByVal file As String, uploadFolder As String)

Dim SharepointAddress As String
Dim LocalAddress As String
Dim objNet As Object
Dim FS As Object

' Where you will enter Sharepoint location path
SharepointAddress = "https://example.com/test_folder/"
' Where you will enter the file path, ex: Excel file
LocalAddress = file
SPFolder = SharepointAddress & uploadFolder & "/"

Debug.Print SPFolder

Set objNet = CreateObject("WScript.Network")
Set FS = CreateObject("Scripting.FileSystemObject")

If FS.FileExists(LocalAddress) Then
    FS.CopyFile LocalAddress, SPFolder
End If

Set objNet = Nothing
Set FS = Nothing

End Function


Sub uploadFiles()

    Dim FileSystem As Object
    Dim HostFolder As String

    HostFolder = GetFolder

    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.GetFolder(HostFolder)
End Sub

Sub DoFolder(folder)
    Dim SubFolder
    Dim LString As String
    Dim LArray() As String
    Dim CertFolder As String
    Dim ufile As String
    Dim pFolder As String
    
    LString = folder
    LArray = Split(LString, "\")
    
    For Each SubFolder In folder.SubFolders
        DoFolder SubFolder
    Next
    Dim file
    For Each file In folder.Files
        CertFolder = LArray(3)
        pFolder = LArray(0) & "\" & LArray(1) & "\" & LArray(2)
        Debug.Print CertFolder
        Debug.Print file
        Debug.Print pFolder
        ufile = file
        sendfile2 ufile, CertFolder, pFolder
    Next
End Sub

Public Sub sendfile2(ByVal file As String, sUrl As String, fPath As String)

On Error GoTo err_Copy

Dim xmlhttp As MSXML2.XMLHTTP60
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Dim LlFileLength As Long
Dim Lvarbin() As Byte
Dim LobjXML As Object
Dim LstrFileName As String
Dim LvarBinData As Variant
Dim PstrFullfileName As String
Dim PstrTargetURL As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr
Dim f
Dim pw As String
Dim UserName As String
Dim RetVal
Dim I As Integer
Dim totFiles As Integer
Dim Start As Date, Finish As Date

Debug.Print file
Debug.Print sUrl

sharepointUrl = "https://example.com/folder/folder"

Set LobjXML = CreateObject("Microsoft.XMLHTTP")

mypath = sharepointUrl & "/" & sUrl
Debug.Print mypath

LobjXML.Open "HEAD", mypath, False 'Check for Directory
LobjXML.Send
If LobjXML.StatusText = "NOT FOUND" Then
    'Create directory if not there
    LobjXML.Open "MKCOL", mypath, False
    LobjXML.Send
End If

Set fldr = fso.GetFolder(fPath & "\" & sUrl)
Debug.Print fldr

totFiles = fldr.Files.Count
For Each f In fldr.Files

  sharepointFileName = sharepointUrl & "/" & sUrl & "/" & f.Name
  Debug.Print sharepointFileName

    PstrFullfileName = fPath & "\" & sUrl & "\" & f.Name
    LlFileLength = FileLen(PstrFullfileName) - 1
    Debug.Print PstrFullfileName
    ' Read the file into a byte array.
    If LlFileLength <> 0 Then
      ReDim Lvarbin(LlFileLength)
      Open PstrFullfileName For Binary As #1
      Get #1, , Lvarbin
      Close #1
    End If
    ' Convert to variant to PUT.
    LvarBinData = Lvarbin
    PstrTargetURL = sharepointUrl & "/" & sUrl & "/" & f.Name

    ' Put the data to the server, false means synchronous.
    LobjXML.Open "PUT", PstrTargetURL, False
   ' Send the file in.
    LobjXML.Send LvarBinData

  'End If

  I = I + 1
  'RetVal = SysCmd(acSysCmdSetStatus, "File " & I & " of " & totFiles & " copied...")

Next f

  'RetVal = SysCmd(acSysCmdClearStatus)
  Set LobjXML = Nothing
  Set fso = Nothing


err_Copy:
If Err <> 0 Then
  MsgBox Err & " " & Err.Description
End If

End Sub

Function GetFolder() As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
          sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Answer 1

您必须使用 SharePoint API，才能安全登录并将文件添加到文档库。如果您可以从 VBA 代码进行 HTTP 调用，那么您可以使用 VBA 中的 SharePoint REST API, or you can download the SharePoint 2013 Client Components SDK, and then reference the Client-Side Object Model (CSOM).dll。请注意，Microsoft 的大部分示例都使用 C#，但适用于 VB.

将文件上传到 SharePoint，不使用 UNC 或驱动器映射

Uploading a file to SharePoint, not using UNC or drive mapping

excel

upload

sharepoint

vba