 |
| 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
Posts
