VBA code to check in a document to Sharepoint and set meta data

Carissima Gold 9 ct Yellow Gold Two-Row Diamond Cut Curb Bracelet of 21 cm/8.5-inch

 

The following VBA code will upload a file to Sharepoint 2007 using a web service, and then sest some meta data (the title) for that file in the document library.
Remember, you need to have installed the VBA Microsoft Office 2003 Web Services Toolkit and created a reference to the web service in your project before this will work. See these previous posts for more information on calling Sharepoint web services from VBA:

• VBA code to iterate through the results of GetListCollection web service from Sharepoint 2007
• Set Sharepoint meta-data from VBA using updatelist web service

' Change these values to your own
sSourceFile = "C:\mtest.doc"  ' File to upload
sTargetFile = "HTTP://my sharepoint site/Shared%20Documents/mytest.doc" ' Target site, document library and file name


' First set up DOM document containing fields
Dim xmlDoc As New MSXML2.DOMDocument30
xmlDoc.async = False

xmlText = "<root>" & _
"<Batch OnError='Continue' ListVersion='" & iVersionNumber & "' PreCalc='TRUE' xmlns=''>" & _
"<Method ID='1' Cmd='Update'>" & _
"<Field Name='ID' />" & _
"<Field Name='FileRef'>" & sTargetFile & "</Field>" & _
"<Field Name='Title'>Uploaded from VBA</Field>" & _
"</Method>" & _
"</Batch>" & _
"</root>"


xmlDoc.LoadXml (xmlText)
Debug.Print xmlText

' This bit is just for testing
If xmlDoc.parseError.errorCode <> 0 Then

Set myErr = xmlDoc.parseError
MsgBox (myErr.reason)
GoTo fnUpload_Error
Else
MsgBox xmlDoc.XML
End If

' Set up IXMLDOMNodeList
Dim myXMLNodeList As MSXML2.IXMLDOMNodeList
Dim root As MSXML2.IXMLDOMElement


Set root = xmlDoc.documentElement
Set myXMLNodeList = root.ChildNodes

' Create an array of IXMLDOMNodeList
Dim ar_Fields(1) As IXMLDOMNodeList
Set ar_Fields(0) = myXMLNodeList
'Debug.Print "ar_Fields(0) = " & ar_Fields(0)


' Now set up an array of strings to hold the URL
Dim ar_URL(1) As String
ar_URL(0) = sTargetFile

Debug.Print "ar_URL(0) = " & ar_URL(0)
' Set up the results object
Dim myresults() As struct_CopyResult

' Set up the byte array and read the source file into it
Dim ar_Stream() As Byte
ar_Stream = ReadFile(sSourceFile)


' NOW CALL WEB SERVICE
' The follwoing comes from the "Microsoft Office 2003 Web Services Toolkit":
'"ar_DestinationUrls" is an array with elements defined as String
'"ar_Fields" is an array with elements defined as IXMLDOMNodeList
'"ar_Stream" is an array with elements defined as Byte
'"ar_Results" is an array with elements defined as struct_CopyResult
'See Complex Types: Arrays in Microsoft Office 2003 Web Services Toolkit Help
'for details on implementing arrays.
documentId = copyws.wsm_CopyIntoItems(sDocumentPath, ar_URL, ar_Fields, ar_Stream, myresults)
Debug.Print "DocumentID = " & documentId

Dim updateReturn As IXMLDOMNodeList

Set updateReturn = listws.wsm_UpdateListItems(sListID, myXMLNodeList)

Dim xmlReturnDoc As New MSXML2.DOMDocument30
If (updateReturn.Length > 0) Then    
xmlReturnDoc.LoadXml (updateReturn.Item(0).XML)

Dim errorText As String
errorText = xmlReturnDoc.Text
If (errorText <> "0x00000000") Then
MsgBox ("Error: Cannot upload load file to Sharepoint." & vbCrLf & _
"     : " & errorText & vbCrLf & Err.Description & vbCrLf )

End If
End If

' Uncomment for debug information.
'MsgBox ("Return XML = " & xmlReturnDoc.XML)

I use the following VBA to read the target file in as a byte array:

Private Function ReadFile(ByVal strFileName As String, Optional ByVal lngStartPos As Long = 1, Optional ByVal lngFileSize As Long = -1) As Byte()
    Dim FilNum As Integer
    FilNum = FreeFile
    Open strFileName For Binary As #FilNum
    If lngFileSize = -1 Then
        ReDim ReadFile(LOF(FilNum) - lngStartPos)  
    Else
        ReDim ReadFile(lngFileSize - 1)
    End If
    Get #FilNum, lngStartPos, ReadFile
    Close #FilNum
End Function