【Sharepoint工具】Excel宏读取Sharepoint列表数据（VBA）

Private Sub GetListBut_Click()
On Error GoTo ErrorHandler
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set clsMossHelper = New CMossHelper
    Dim myTable As ListObject
    Dim myRow As ListRow
    Dim listName As String
    Dim xmlDoc As MSXML2.domDocument
    Dim xmlNode As MSXML2.IXMLDOMNode
    Dim xmlAttribute As MSXML2.IXMLDOMAttribute
    Set myTable = ActiveWorkbook.Sheets("Sheet1").ListObjects("Table1")
    
    clsMossHelper.Init "AAA", "http://AAA:222/yixiaozi"
    listName = "ABC"
    
    Dim viewName As String
    ‘ForToolUpdate
    viewName = "{f5022e21-7a8d-40c1-b327-d9db9e227f33}"
    ‘viewName = "{324DD64B-ED68-4E86-83D0-321E1AB2D403}"
    
    For Each myRow In myTable.ListRows
        
        Dim query As String
        
        query = "<query><Query><Where><Eq><FieldRef Name=‘Title‘ /><Value Type=‘Text‘>"
        query = query & myRow.Range.Columns(1).Value
        query = query & "</Value>"
        query = query & "</Eq></Where></Query></query>"
        
        ‘query = "<query><Query><Where><And><Eq><FieldRef Name=‘Title‘ /><Value Type=‘Text‘>"
        ‘query = query & "a"
        ‘query = query & "</Value>"
        ‘query = query & "</Eq><Eq><FieldRef Name=‘description‘ /><Value Type=‘Text‘>"
        ‘query = query & "2"
        ‘query = query & "</Value></Eq></And></Where></Query></query>"
        
        Dim blnFlag As Boolean
        Dim errorMsg As String
        Dim retData As String
          
        blnFlag = clsMossHelper.GetListItems(listName, viewName, query, retData, errorMsg)
        If blnFlag = True Then
             
             
            Set xmlDoc = New MSXML2.domDocument
            
            xmlDoc.LoadXML retData
            For Each xmlNode In xmlDoc.SelectNodes("//rs:data/z:row")
            Dim description
            
            Set description = xmlNode.Attributes.getNamedItem("ows_description")
                
                If description Is Nothing Then
                    description = ""
                Else
                    description = description.Text
                End If
                
               myRow.Range.Columns(2).Value = description
            Next
        Else
            MsgBox errorMsg
        End If
    Next
    Set xmlAttribute = Nothing
    Set xmlNode = Nothing
    Set xmlDoc = Nothing
    
    Set clsMossHelper = Nothing
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox "OK"
Exit Sub

ErrorHandler:
          
    If Not xmlAttribute Is Nothing Then
        Set xmlAttribute = Nothing
    End If
    
    If Not xmlNode Is Nothing Then
        Set xmlNode = Nothing
    End If
    
    If Not xmlDoc Is Nothing Then
        Set xmlDoc = Nothing
    End If
    
    If Not clsMossHelper Is Nothing Then
        Set clsMossHelper = Nothing
    End If
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    MsgBox Err.description
    

End Sub