2017-09-15 36 views
0

我试图建立一个VBA函数,将更新SharePoint列表中的值:如何通过Sharepoint REST发送列表更新时处理“操作中止”错误?

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 

但当testUpdate到达线路:

XmlHttp.Send body 

它抛出这个错误:

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

Operation aborted 

尽管出现错误,更新成功 - 列表项的标题值发生更改。

我是否安全地处理这个异常并绕过错误,还是说明存在真正需要解决的问题?

+0

我刚刚看了这个帖子.... https://stackoverflow.com/questions/46247627/excel-vba-send-to-msxml2- xmlhttp-does-not-work ......也许尝试使用'MSXML2.ServerXMLHTTP60' – jsotola

+0

@jsotola,我尝试使用'ServerXMLHTTP60'代替,但得到了'401未授权的错误,并且更新没有通过。 – sigil

+0

看起来像服务器可能需要登录凭据 – jsotola

回答

0

api调用需要验证。我设法使用WinHTTP来验证基于当前用户的请求,我假设他们有权访问下面的内容。我收到了204回复,并且我的清单项目正确更新。 (迭代是因为我正在测试性能,可以删除)。

工具>引用>微软WINHTTP服务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 
相关问题