Какой правильный код VBA для загрузки файла в sharepoint, без использования UN C или сопоставления дисков

Question

Я пытаюсь найти правильный код, который позволяет мне загружать файлы в sharepoint, используя vba и макросы в Excel. Я нашел некоторый код urlmon, который решил проблему загрузки файла макроса. Я видел много кода, который фокусируется на Scripting.FileSystemObject с использованием UN C, winhttp POST и SEND и SP SDK, но я не смог заставить последний работать из-за ограничений установки сайта и программного обеспечения.

Мне нужно иметь возможность загружать напрямую, например, на "http://example.com/foldername". Я пытался использовать Scripting.FileSystemObject с URL-адресом, но он не работает.

Я делаю смелое предположение, что существует допустимый метод vba, отличный от UN C, и winhttp POST / SEND для загрузка файлов в sharepoint. Если, конечно, они являются единственными двумя вариантами?

Ниже приведен код, который я пытался выполнить, скопированный с чужой работы над переполнением стека.

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

Вы должны использовать API-интерфейс SharePoint для безопасного входа и добавления файлов в библиотеку документов. Если вы можете совершать HTTP-вызовы из своего кода VBA, то вы можете использовать SharePoint REST API или загрузить Клиентские компоненты SharePoint 2013 SDK , а затем ссылаться на Клиентская объектная модель (CSOM) .dll от VBA. Помните, что большинство примеров Microsoft приведены в C#, но могут быть адаптированы к VB.