Many changes
- Accepts multiple fields as a dictionary object - Creates a new list item if there isn't an existing one - Updates an existing list item if the ID is passed in
This commit is contained in:
parent
0eb27a0bcd
commit
24c19b5acb
@ -1,39 +1,43 @@
|
||||
Attribute VB_Name = "SPListLibrary"
|
||||
Public Function Add_Item(ListName As String, SharepointUrl As String, ValueVar As String, FieldNameVar As String) As Integer
|
||||
Public Function SPListItem(SharepointUrl As String, ListName As String, ListData As Dictionary, Optional itemid As Integer = 0) As Integer
|
||||
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
|
||||
|
||||
Set objXMLHTTP = New MSXML2.XMLHTTP
|
||||
|
||||
strListNameOrGuid = ListName
|
||||
|
||||
strBatchXml = "<Batch OnError='Continue'><Method ID='3' Cmd='New'><Field Name='ID'>New</Field><Field Name=" + FieldNameVar + ">" + ValueVar + "</Field></Method></Batch>"
|
||||
|
||||
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"
|
||||
|
||||
|
||||
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>" & strListNameOrGuid _
|
||||
& "xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>" & ListName _
|
||||
& "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
|
||||
|
||||
|
||||
objXMLHTTP.send strSoapBody
|
||||
|
||||
|
||||
If objXMLHTTP.Status = 200 Then
|
||||
Set xmlhttpResponse = objXMLHTTP.responseXML
|
||||
Add_Item = CInt(xmlhttpResponse.SelectSingleNode("//UpdateListItemsResult//Results//Result//z:row").Attributes.getNamedItem("ows_ID").Text)
|
||||
CreateSPItem = CInt(xmlhttpResponse.SelectSingleNode("//UpdateListItemsResult//Results//Result//z:row").Attributes.getNamedItem("ows_ID").Text)
|
||||
Else
|
||||
MsgBox ("Some kind of error happened. Wut?")
|
||||
Add_Item = -1
|
||||
CreateSPItem = -1
|
||||
End If
|
||||
|
||||
Set objXMLHTTP = Nothing
|
||||
End Function
|
||||
|
||||
|
||||
End Function
|
Loading…
Reference in New Issue
Block a user