VBA-SharePoint-List-Functions/SPListLibrary.bas

Attribute VB_Name = "SPListLibrary"
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
    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>" & ListName _
    & "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
    
    objXMLHTTP.send strSoapBody
    
    If objXMLHTTP.Status = 200 Then
        Set xmlhttpResponse = objXMLHTTP.responseXML
        CreateSPItem = CInt(xmlhttpResponse.SelectSingleNode("//UpdateListItemsResult//Results//Result//z:row").Attributes.getNamedItem("ows_ID").Text)
    Else
        CreateSPItem = -1
    End If
    
    Set objXMLHTTP = Nothing
End Function