VBScript上传文件到SharePoint DocLib

Question

VBScript上传文件到SharePoint DocLib

4

我正在尝试自动上传文件到SharePoint文档库。我已经阅读了很多帖子（在这个论坛和其他论坛），但似乎无法得到有效的解决方案。虽然我做过一些简单的VBA和VB脚本，但我并不是真正的开发人员。

我正在寻找一个解决方案，可以使用VBA或VB脚本自动将文件（特别是.xlsx和.zip类型）从本地计算机上传到特定的SharePoint文档库（让我们使用“.../sharepoint/Metrics/Forms/AllItems.aspx”作为列表）。

在研究这个问题时，以下是一些其他想法/评论，希望能帮助提供解决方案的人：

- 我不能更改SharePoint服务器上的任何内容 - 我需要在上传文件时传递凭据 - 我只寻找VBA/VBS解决方案（没有C#或.NET） - 我可能需要在上传时设置元数据

非常感谢您的帮助。

- user457338

4个回答

0

关于将驱动器字母映射到SharePoint文档库，然后像正常情况下一样复制/移动文件，您怎么看？

http://blog.crowe.co.nz/archive/2005/08/31/244.aspx

- Shane

0

您最好的解决方案是使用FP RPC（即Frontpage远程过程调用）。这基本上是一个Web请求，您可以将元数据和文件内容作为参数传递。这可以从任何语言中完成，包括VBA / VBS。这是该方法的正式描述：http://msdn.microsoft.com/en-us/library/ms479623.aspx 您可以找到很多资源和代码示例来构建实用程序。

- Vladi Gubler

0

这是我完成这个任务的方法，现在我需要找到一种通过VBScript检查文档的方式。

function SPCopy(InFileName, InPath, oFS)

    SPURL = ""
    SPSource = InPath & "\" & InFileName

    ' determine which sharepoint path to copy the excel workbook to
    If InStr(InFileName, "Email") > 0 Then
        SPURL = "\\sharepoint\sites\IS\Shared Documents\Email Reports"
    ElseIf InStr(InFileName, "FTP") > 0 Then
        SPURL = "\\sharepoint\sites\IS\Shared Documents\FTP Reports"
    ElseIf InStr(InFileName, "SSL") > 0 Then
        SPURL = "\\sharepoint\sites\IS\Shared Documents\SSL Reports"
    End If 

    If SPURL = "" Then
        MsgBox "File: " & SPSource & " is not a valid file from STRM..." & vbCrLf & _
            "Not sure where to upload it to SharePoint... " & vbCrLf & vbCrLf & _
            SPSource & " will be deleted...", 48, "myScript"
        Exit Function
    End If

    ' build the final part of the path based on the year and month
    MyDate = Left(InFileName, 4) & "_" & MonthName(Mid(InFileName, 5, 2))
    MyTitle = Mid(InFileName, 10, InStr(InFileName, ".") - 10)
    SPURL = SPURL & "\" & MyDate
    DestFile = SPURL & "\" & InFileName

    ' copy the file(s) to the sharepoint path if its not already there
    If Not oFS.FileExists(DestFile) Then
        oFS.CopyFile SPSource, SPURL, True
    End If
end function

- Steve Steiner

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- user128300 · Accepted Answer

以下VBScript使用FrontPage RPC上传文件：

以下是VBScript代码：

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字符组成。否则，上述脚本将无法正常工作。