Question

我在SO，SU和SP.SE搜索了一个解决方案，但找不到我需要的东西。我正在寻找一个解决方案，可能是一个脚本或一些其他非编码方法/工具。

我正在尝试编写一个脚本（供其他人使用）或其他一些自动化形式，以自动将各种报告上传到SharePoint网站。我设法让以下（VBScript）代码工作，但仅适用于基于文本的文件 - 在这种情况下为.CSV，尽管这也适用于.TXT等。

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

这仅适用于文本文件，因为它将文本数据管道传输到SP站点上的文件中。但是，如果我想传输任何类型的二进制文件（.XLS，.PDF），这会导致垃圾上传。

我试着看一下Shell.Application ==＆gt; .Namespace()，但这似乎不适用于URL，而只适用于物理驱动器。这是我尝试的其他一些内容（修剪以显示相关部分）：

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

我还尝试使用xcopy批处理文件，但也无法连接到http://。我看了this method，这可能对我有用，但我不想处理映射/ NET USE，因为我们公司有多个网络共享，其映射根据谁登录而有所不同。

由于这些都不是我需要的方式：是否有自动执行此类功能的方法？

我有使用VBA / VBscript的经验，所以要么像上面这样的脚本，要么内置到MS Office应用程序中的东西（Outlook最好，但我可以适应我给出的任何东西）会更好。话虽这么说，我愿意接受任何允许我这样做的方法，在Windows或Office中本机运行。但是，我无权访问Visual Studio，因此无法使用任何.NET功能。

Answer 1

感谢Sean Cheshire指出了我没有看到的明显答案。发布相关代码，因为我不认为这在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

这是VBA代码，格式化为主要使用VBScript，但我无法正确传输此块。作为VBA，可以通过分配数据类型等来改进它。

' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1

Answer 2

这是一个非常古老的帖子，但非常有用，所以感谢每个人的贡献。这是我的早期绑定版本。我发现由于VBA假设没有声明变量类型，之前的帖子没有用。

＆＃13;

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 Sub

＆＃13;

仅供参考，以上代码需要2个参考。 1. Microsoft XML，v6.0 2. Microsoft Scripting Runtime

希望这有助于提高已经很出色的答案!!

批量复制文件到SharePoint站点

2 个答案: