1
0
Fork 0
VBA-SharePoint-List-Functions/SPListLibrary.bas

43 lines
1.9 KiB
QBasic
Raw Normal View History

2016-01-26 22:50:13 +00:00
Attribute VB_Name = "SPListLibrary"
Public Function SPListItem(SharepointUrl As String, ListName As String, ListData As Dictionary, Optional itemid As Integer = 0) As Integer
2016-01-26 22:50:13 +00:00
Dim objXMLHTTP As MSXML2.XMLHTTP
Dim strListNameOrGuid As String
Dim strBatchXml As String
Dim strSoapBody As String
Dim xmlhttpResponse As New MSXML2.DOMDocument
Dim attr As Object
Dim key As Variant
strBatchXml = ""
For Each key In ListData
strBatchXml = strBatchXml & "<Field Name='" & key & "'>" & ListData(key) & "</Field>"
Next key
If itemid = 0 Then
strBatchXml = "<Batch OnError='Continue'><Method ID='1' Cmd='New'>" & strBatchXml & "</Method></Batch>"
Else
strBatchXml = "<Batch OnError='Continue'><Method ID='1' Cmd='Update'><Field Name='ID'>" & itemid & "</Field>" & strBatchXml & "</Method></Batch>"
End If
2016-01-26 22:50:13 +00:00
Set objXMLHTTP = New MSXML2.XMLHTTP
objXMLHTTP.Open "POST", SharepointUrl + "_vti_bin/Lists.asmx", False
objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
objXMLHTTP.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
2016-01-26 22:50:13 +00:00
strSoapBody = "<soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " _
& "xmlns:xsd='http://www.w3.org/2001/XMLSchema' " _
& "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'><soap:Body><UpdateListItems " _
& "xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>" & ListName _
2016-01-26 22:50:13 +00:00
& "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
2016-01-26 22:50:13 +00:00
objXMLHTTP.send strSoapBody
2016-01-26 22:50:13 +00:00
If objXMLHTTP.Status = 200 Then
Set xmlhttpResponse = objXMLHTTP.responseXML
2016-06-29 01:01:34 +00:00
SPListItem = CInt(xmlhttpResponse.SelectSingleNode("//UpdateListItemsResult//Results//Result//z:row").Attributes.getNamedItem("ows_ID").Text)
2016-01-26 22:50:13 +00:00
Else
2016-06-29 01:01:34 +00:00
SPListItem = -1
2016-01-26 22:50:13 +00:00
End If
Set objXMLHTTP = Nothing
End Function