RPC（VBScript）を使用してSharePointにファイルをアップロード

Question

私は現在、以下のVBスクリプトとFrontpage RPC呼び出しを使用して、ドキュメント内にドキュメントとそのパースペクティブメタデータ値を設定します。ただし、拡張子が* .xlsxまたは* .docxのファイルは、このスクリプトを使用してメタデータをアップロードしません。

さまざまなWebサイトを調査した後、_vti_aut/author.dllがWSS 3.0の新しいオープンオフィスフォーマットを処理する方法に問題があるようです。ファイルがSharePointサイトにアップロードされた後、SetDocsMetaInfoメソッドを使用することをお勧めします。

問題は、このスクリプトでこのメソッドを使用する方法がわかりません。私はそれを使用しようとすると、* .xlsxファイルまたは* .docxファイルを正しいメタデータでアップロードできますが、ファイルが破損することがあります。

私が調査したウェブサイトには、ファイルがエンコードされている可能性があることが示唆されていますが、正確にトラブルシューティングを行うにはエンコーディングで十分ではありません。

このメソッド（SetDocsMetaInfo）を以下のスクリプトで使用する方法や、このスクリプトを使用してこの問題を解決する方法の例をいくつか教えてください。

このオリジナルのスクリプトはこのウェブサイトから取得されました：

UploadFile "C:\Test\Work\temp\defer\testDoc_083011.xlsx", _  
"http://sharepoint.domainname.com/Sites/SITE1", _  
"TestImport/folder1/testDoc_083011.xlsx_083011.xlsx", _  
"Test", _  
"Test checkin comment", _  
"", "" 

MsgBox "Done" 

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) + ";Business Unit%3bSW%7c" + Escape("Business Unit")+ "]]" + _  
    "&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 

Answer 1

は、私はこの問題を抱えていたし、日常の明らかに非推奨バージョンを使用して設定した文書のメタ情報の下のコードにつきとして働いていたことがわかっはOK働い：

Public Sub SetSPMetaData(ByVal sURL As String, ByVal sDocName As String, ByVal sTitle As String, _ 
        Optional ByVal OriginalPath As String, Optional ByVal OriginalName As String, _ 
        Optional ByVal ModDate As Date, Optional ByVal FileID As Long) 

Dim strHeader As String 
Dim byteArray() As Byte 
Dim stream As New ADODB.stream 
Dim stream2 As New ADODB.stream 
Dim xmlHTTP As New MSXML2.xmlHTTP 
Dim sTempFile As String 
Dim UserName As String 
Dim Password As String 


On Error GoTo SetSPMetaData_Error 

'Method = setDocsMetaInfo: server_extension_version 
'&service_name=/[&listHiddenDocs=(true|false)] 
'&listLinkInfo=(true|false)&url_list=list_of_urls 
'&metaInfoList=(list_of_meta_info)[&errorFlags=(KeepGoing|StopOnFirst)] 


'POST /site_url/_vti_bin/_vti_aut/author.dll HTTP/1.0 
'. 
'. 
'. 
'method=set+docs+meta+info:6.0.n.nnnn 
'&service_name=/ 
'&url_list=[List_Name/File_Name] 
'&metaInfoList=[[vti_title;SR|Web+Settingt;SW|fp40]]true 
'&listLinkInfo=true 

If OriginalPath = "" And OriginalName = "" Then 
    strHeader = "method=set+document+meta-info:6.0.n.nnnn" + _ 
       "&service_name=/&document_name=" & sDocName & _ 
       "&meta_info=[vti_title;SR|" & Replace(Escape(sTitle), "%5C", "%5C%5C") & "]" 
Else 

    If OriginalName = "" Then 
     If CLng(ModDate) = 0 Then 

      strHeader = "method=set+document+meta-info:6.0.n.nnnn" + _ 
         "&service_name=/&document_name=" & sDocName & _ 
         "&meta_info=[vti_title;SR|" & Replace(Escape(sTitle), "%5C", "%5C%5C") & _ 
         ";Original Path;SR|" & Replace(Escape(OriginalPath), "%5C", "%5C%5C") & "]" 


     Else 

      strHeader = "method=set+document+meta-info:6.0.n.nnnn" + _ 
         "&service_name=/&document_name=" & sDocName & _ 
         "&meta_info=[vti_title;SR|" & Replace(Escape(sTitle), "%5C", "%5C%5C") & _ 
         ";Original Modified|" & Format(ModDate, "DD MMM YYYY hh:mm:ss") & _ 
         ";Original Path;SR|" & Replace(Escape(OriginalPath), "%5C", "%5C%5C") & "]" 

     End If 

    Else 

     If CLng(ModDate) = 0 Then 
      strHeader = "method=set+document+meta-info:6.0.n.nnnn" + _ 
         "&service_name=/&document_name=" & sDocName & _ 
         "&meta_info=[vti_title;SR|" & Replace(Escape(sTitle), "%5C", "%5C%5C") & _ 
         ";Original Name;SR|" & Replace(Escape(OriginalName), "%5C", "%5C%5C") & _ 
         ";Original Path;SR|" & Replace(Escape(OriginalPath), "%5C", "%5C%5C") & "]" 
     Else 

      strHeader = "method=set+document+meta-info:6.0.n.nnnn" + _ 
         "&service_name=/&document_name=" & sDocName & _ 
         "&meta_info=[vti_title;SR|" & Replace(Escape(sTitle), "%5C", "%5C%5C") & _ 
         ";Original Name;SR|" & Replace(Escape(OriginalName), "%5C", "%5C%5C") & _ 
         ";Original Modified;TW|" & Format(ModDate, "DD MMM YYYY hh:mm:ss") & _ 
         ";Original Path;SR|" & Replace(Escape(OriginalPath), "%5C", "%5C%5C") & "]" 

     End If 
    End If 
End If 

byteArray = StringToByteArray(strHeader) 

'Set stream = CreateObject("ADODB.Stream") 

If gConfig.GetConfig("frmHTTPAuthentication") = 2 Then 
    If gConfig.GetConfig("txtUserPassword") <> "" Then Password = gConfig.GetConfigDecrypt("txtUserPassword") 
    If gConfig.GetConfig("txtUserName") <> "" Then UserName = gConfig.GetConfigDecrypt("txtUserName") 
End If 

stream.Open 
stream.Type = 1 ''adTypeBinary 
stream.Write byteArray 


stream.Position = 0 
'stream.SaveToFile "C:\StreamContent.txt" 

xmlHTTP.Open "POST", sURL + "/_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, "osstatus=0") <> 0 Then 
     '230    MsgBox "Error - " & cleanup_html(xmlHTTP.responseText) 
     Call LogErrorFilFol(GetFileFromPath(sURL), GetFolderFromPath(sURL), _ 
          "SetSPMetaData - osstatus = 0 - " & cleanup_html(xmlHTTP.responseText), FileID) 
    End If 
    '260   Debug.Print xmlHTTP.responseText 

Else 

    Call LogErrorFilFol(GetFileFromPath(sURL), GetFolderFromPath(sURL), "SetSPMetaData - Status = " & xmlHTTP.Status, FileID) 

End If