1

I'm trying to build a VBA function that will update a value in a Sharepoint list:

Sub testUpdate()    
    Dim XmlHttp As MSXML2.XMLHTTP60
    Dim result As String
    Dim url As String
    Dim body As String
    Dim RequestDigest As String

    Set XmlHttp = New MSXML2.XMLHTTP60

    url = "https://sps.utility.xyz.com/sites/xyz/_api/web/lists/GetByTitle('REST Test List')/items(1)"

    RequestDigest = GetDigest("https://sps.utility.xyz.com/sites/xyz")

    body = "{ '__metadata': { 'type': 'SP.Data.REST_x0020_Test_x0020_ListListItem' }, 'Title': 'updating item with new title'}"
    XmlHttp.Open "POST", url, False
    XmlHttp.setRequestHeader "IF-MATCH", "*"
    XmlHttp.setRequestHeader "accept", "application/json;odata=verbose"
    XmlHttp.setRequestHeader "content-type", "application/json;odata=verbose"
    XmlHttp.setRequestHeader "X-Http-Method", "MERGE"
    XmlHttp.setRequestHeader "X-RequestDigest", RequestDigest
    XmlHttp.setRequestHeader "Content-Length", Len(body)

    XmlHttp.Send body

    result = XmlHttp.responseText
End Sub    

Function GetDigest(url As String)
    Dim oHttp As New MSXML2.XMLHTTP60
    Dim s As String
    Dim l1 As Long
    Dim l2 As Long

    With oHttp
        .Open "POST", url + "/_api/contextinfo", False
        .setRequestHeader "content-type", "application/json;odata=verbose"
        .Send ""
    End With

    s = oHttp.responseText
    l1 = InStr(1, s, "FormDigestValue")
    If l1 > 10 Then
       l1 = l1 + 16
       l2 = InStr(l1, s, "</d:FormDigestValue")
    End If

    If l2 > 10 Then GetDigest = Mid$(s, l1, l2 - l1)
       Set oHttp = Nothing    
End Function

But when testUpdate gets to the line:

XmlHttp.Send body

it throws this error:

Run-time error '-2147467260 (80004004)':

Operation aborted

Despite the error, the update succeeds--the list item's Title value changes.

Is it safe for me to simply handle this exception and bypass the error, or is it indicating that there is a real problem that I need to resolve?

Zsmaster
  • 1,549
  • 4
  • 19
  • 28
sigil
  • 9,370
  • 40
  • 119
  • 199
  • i just read this post .... https://stackoverflow.com/questions/46247627/excel-vba-send-to-msxml2-xmlhttp-does-not-work ...... maybe try to use `MSXML2.ServerXMLHTTP60` – jsotola Sep 17 '17 at 06:25
  • @jsotola, I tried using `ServerXMLHTTP60` instead, but got a `401 Unauthorized` error and the update didn't go through. – sigil Sep 18 '17 at 22:17
  • 1
    looks like the server may require login credentials – jsotola Sep 18 '17 at 23:26

1 Answers1

1

The api call requires authentication. I managed to use WinHTTP to authenticate the request based on the current user, I am assuming that they have access in the below. I get a 204 response and my list item updates correctly. (the iteration is because I was testing performance and can be removed).

Tools>references>Microsoft WinHttp Services Version 5.1

Private Sub UpdateItem2(ID, strFormDigest As String, iteration)
    Dim sUrl As String
    sUrl ="https://123.Sharepoint.net/sites/123/_api/web/lists/getbytitle('MyDemoList')/items(" & ID & ")"
    Dim oRequest As WinHttp.WinHttpRequest
    Dim sResult As String
    sEnv = "{ '__metadata': { 'type': 'SP.Data.MyDemoListListItem' }, 'Title': 'TEST" & iteration & "' }"
    Set oRequest = New WinHttp.WinHttpRequest
    With oRequest
        .Open "POST", sUrl, True
        .setRequestHeader "IF-MATCH", "*"
        .setRequestHeader "X-HTTP-Method", "MERGE"
        .setRequestHeader "accept", "application/json;odata=verbose"
        .setRequestHeader "X-RequestDigest", strFormDigest
        .setRequestHeader "content-type", "application/json;odata=verbose"
        .SetAutoLogonPolicy AutoLogonPolicy_Always
        .send sEnv
        .waitForResponse
 End With
 End Sub
Matayp
  • 26
  • 3