正在将文件上载到SharePoint,而不使用UNC或驱动器映射



我正在尝试使用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

您必须使用SharePoint API才能安全登录并将文件添加到文档库。如果可以从VBA代码进行HTTP调用,则可以使用SharePoint REST API,也可以下载SharePoint 2013客户端组件SDK,然后从VBA引用客户端对象模型(CSOM(.dlls。注意,微软的大多数例子都是用C#编写的,但都适用于VB.

最新更新