将文件上载到SharePoint DocLib的VBScript

Question

我正在尝试自动将文件上载到SharePoint文档库.我遇到了无数的帖子(在这个论坛上和其他人),但似乎无法获得有用的东西.虽然我做了一些简单的VBA和VB脚本,但我并不是真正的开发人员.

我正在寻找的是一个自动上传文件(特别是.xlsx和.zip类型)从本地机器到特定SharePoint文档库的解决方案(让我们使用".../sharepoint/Metrics/Forms/AllItems.aspx "作为列表"使用VBA或VB脚本.

在研究这个问题时,这里有一些其他的想法/评论,希望能帮助某人为我提供解决方案:

• 我无法在SharePoint服务器上进行任何更改
• 我需要能够在上传文件时传递凭据
• 我只是在寻找VBA/VBS解决方案(没有C#或.NET)
• 我可能需要在上传时设置元数据

预先感谢您的任何帮助.

Answer 1

以下VBScript使用FrontPage RPC上载文件:

Function StringToByteArray(str)
   Set stream = CreateObject("ADODB.Stream")
   stream.Open
   stream.Type = 2 ''adTypeText
   stream.Charset = "ascii"
   stream.WriteText str
   stream.Position = 0
   stream.Type = 1 ''adTypeBinary
   StringToByteArray = stream.Read()
   stream.Close
End Function

Sub UploadFile(sourcePath, siteUrl, docName, title, checkincomment, userName, password)

   strHeader = "method=put+document%3a12.0.4518.1016" + _
      "&service_name=%2f" + _
      "&document=[document_name=" + Escape(docName) + _
      ";meta_info=[vti_title%3bSW%7c" + Escape(title) + "]]" + _
      "&put_option=overwrite,createdir,migrationsemantics" + _
      "&comment=" + _
      "&keep%5fchecked%5fout=false" + vbLf
   bytearray = StringToByteArray(strHeader)

   Set stream = CreateObject("ADODB.Stream")
   stream.Open
   stream.Type = 1 ''adTypeBinary
   stream.Write byteArray

   Set stream2 = CreateObject("ADODB.Stream")
   stream2.Open
   stream2.Type = 1 ''adTypeBinary
   stream2.LoadFromFile sourcePath
   stream2.CopyTo stream, -1
   stream.Position = 0

   Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
   xmlHttp.open "POST", siteUrl + "/_vti_bin/_vti_aut/author.dll", false, userName, password
   xmlhttp.setRequestHeader "Content-Type","application/x-vermeer-urlencoded"
   xmlhttp.setRequestHeader "X-Vermeer-Content-Type","application/x-vermeer-urlencoded"
   xmlhttp.setRequestHeader "User-Agent", "FrontPage"
   xmlHttp.send stream

   If xmlHttp.status = 200 Then

       If Instr(xmlHttp.responseText, "successfully") = 0 Then

          MsgBox "ERROR: " & vbCrLf & xmlHttp.responseText       

       Else

          ''Checkin

          strHeader = "method=checkin+document%3a12.0.4518.1016" + _
             "&service_name=%2f" + _
             "&document_name=" & Escape(docName) + _
             "&comment=" + Escape(checkincomment) + _
             "&keep%5fchecked%5fout=false" + vbLf

          Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
          xmlHttp.open "POST", siteUrl + "/_vti_bin/_vti_aut/author.dll", false, userName, password
          xmlhttp.setRequestHeader "Content-Type","application/x-vermeer-urlencoded"
          xmlhttp.setRequestHeader "X-Vermeer-Content-Type","application/x-vermeer-urlencoded"
          xmlhttp.setRequestHeader "User-Agent", "FrontPage"
          xmlHttp.send strHeader



       End If

   End If

   If xmlHttp.status / 100 <> 2 Then
      MsgBox "ERROR: status = " & xmlHttp.status & vbCrLf & xmlHttp.responseText
   End If

End Sub

UploadFile "C:\Users\myusername\Desktop\Test File.zip", _
    "http://computername/Sites/sitename", _
    "Requirements/Test File.zip", _
    "Test title", _
    "Test checkin comment", _
    "MYDOMAIN\myusername", "mypassword"
MsgBox "Done"

请注意,文件名应仅包含ASCII字符.否则,上面的脚本将无法正常工作.