问题
I searched SO, SU, and SP.SE for a solution, but could not find what I needed. I'm looking for a solution which may be a script or some other non-coding method/tool.
I am trying to write a script (to be used by others) or some other form of automation to upload various reports automatically to a SharePoint site. I have managed to get the following (VBScript) code to work, but only for text-based files -- .CSV in this case, though this also works for .TXT, etc.
Option Explicit
Dim sCurPath
sCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
UploadAllToSP sCurPath
Sub UploadAllToSP(sFolder)
Dim fso, folder, fil
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(sFolder)
For Each fil In folder.Files
If fso.GetExtensionName(fil) = "csv" Then
UploadFileToSP fil
End If
Next
End Sub
Sub UploadFileToSP(ofile)
Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Set tsIn = ofile.openAsTextstream
sBody = tsIn.readAll
tsIn.close
sharepointUrl = "http://SHAREPOINT URL HERE"
sharepointFileName = sharepointUrl & ofile.name
set xmlHttp = createobject("MSXML2.XMLHTTP.4.0")
xmlhttp.open "PUT", sharepointFileName, false
xmlhttp.send sBody
If xmlhttp.status < 200 Or xmlhttp.status > 201 Then
wscript.echo "There was a problem uploading " & ofile.name & "!"
End If
End Sub
This only works for text files because it pipes the text data into a file on the SP site. However, if I want to transfer any kind of binary file (.XLS, .PDF), this results in garbage being uploaded.
I tried to take a look at a Shell.Application ==> .Namespace(), but this doesn't seem to work with a URL, but only a physical drive. Here's some of what else I tried (trimmed to show relevant pieces):
Set oApp = CreateObject("Shell.Application")
If oApp.NameSpace(sharepointUrl) <> Null then ' Always Null!
' Copy here
' Some lines omitted
oApp.NameSpace(sharepointUrl).CopyHere ofile.Name ' This also fails when not surrounded by the Null check
Else
MsgBox "SharePoint directory not found!"
End If
I also tried a batch file using xcopy, but that can't connect to the http:// either. I looked at this method, which may work for me, but I'd prefer not to deal with mapping/NET USE, since our company has multiple network shares, the mapping for which varies depending on who's logged in.
Since none of these work quite the way I need: Is there a method to automate this kind of functionality?
I have experience with VBA/VBscript, so either a script like the above, or something built in to an MS Office application (Outlook is best, but I can probably adapt whatever I am given) would be preferable. That being said, I am open to any method that would allow me to do this, running natively in Windows or Office. However, I do not have access to Visual Studio, so I can't use any .NET functionality.
回答1:
Thanks to Sean Cheshire for pointing me at the obvious answer that I did not see. Posting the relevant code, since I don't believe this yet exists on SO.
Sub UploadFilesToSP(sFolder)
Dim sharepointUrl
Dim sharepointFileName
Dim LlFileLength
Dim Lvarbin()
Dim LobjXML
Dim LvarBinData
Dim PstrFullfileName
Dim PstrTargetURL
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr
Dim f
'This has not been successfully tested using an "https" connection.
sharepointUrl = "http://SHAREPOINT URL HERE"
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
Set fldr = fso.GetFolder(sFolder)
For Each f In fldr.Files
sharepointFileName = sharepointUrl & f.Name
PstrFullfileName = sFolder & f.Name
LlFileLength = FileLen(PstrFullfileName) - 1
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
' Convert to variant to PUT.
LvarBinData = Lvarbin
PstrTargetURL = sharepointFileName
' Put the data to the server, false means synchronous.
LobjXML.Open "PUT", PstrTargetURL, False
' Send the file in.
LobjXML.Send LvarBinData
Next f
Set LobjXML = Nothing
Set fso = Nothing
End Sub
This is VBA code, formatted to mostly work with VBScript, though I could not get this block to transfer properly. As VBA, this can be improved some by assigning data types, etc.
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
回答2:
This is a very old post but a very useful one so thanks to everyone's contribution. This is my version with the early binding. I found that the previous posting didn't work due to VBA assumption of the none declared variable types.
Private Sub cmdUploadToApplicationsAndApprovals_Click()
Dim strSharePointUrl As String
Dim strSharePointFileName As String
Dim lngFileLength As Long
Dim bytBinary() As Byte
Dim objXML As XMLHTTP
Dim varBinData As Variant
Dim strFullfileName As String
Dim strTargetURL As String
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim folder As folder
Dim file As file
Dim strFolder As String
strFolder = CurrentProject.Path & "\Upload\"
'This has not been successfully tested using an "https" connection.
strSharePointUrl = "http://sps.mysite.ca/subsite/DocLib/"
Set objXML = New XMLHTTP 'CreateObject("Microsoft.XMLHTTP")
Set folder = fso.GetFolder(strFolder)
For Each file In folder.Files
strSharePointFileName = strSharePointUrl & file.Name
strFullfileName = strFolder & file.Name
lngFileLength = FileLen(strFullfileName) - 1
'Read the file into a byte array.
ReDim bytBinary(lngFileLength)
Open strFullfileName For Binary As #1
Get #1, , bytBinary
Close #1
'Convert to variant to PUT.
varBinData = bytBinary
strTargetURL = strSharePointFileName
'Put the data to the server, false means synchronous.
objXML.Open "PUT", strTargetURL, False
'Send the file in.
objXML.Send varBinData
'Now Update the metadata
Next file
'Clean up
Set objXML = Nothing
Set fso = Nothing
MsgBox "Done"
End SubFYI the above code required 2 references. 1. Microsoft XML, v6.0 2. Microsoft Scripting Runtime
Hope this helps improve on the already brilliant answer!!
来源：https://stackoverflow.com/questions/12039730/batch-copy-files-to-sharepoint-site