zoukankan      html  css  js  c++  java
  • 【Sharepoint工具】Excel宏读取Sharepoint列表数据(VBA)

    第一、开发原因:

    某些时候Sharepoint列表的操作并不方便,比如数据量大,需要批量处理数据的时候。通过服务器代码有太多限制,比如智能通过B/S发送给用户,速度慢且影响服务器性能。
    客户端代码同样有一些慢。

    第二、具体界面:

    第三具体代码:

    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

    第四:Excel文件。

    http://files.cnblogs.com/files/yixiaozi/getListData.zip

  • 相关阅读:
    取石子(斐波那契博弈)
    Kindergarten(网络流解法)
    最大团的一些定理
    Escape(多记一个方向状态的BFS)迷宫逃脱
    网络流的一些定理
    线段树维护动态连续子段HDU1540
    最大流Dinic(模板)
    MCMF最大流最小割(模板)Dijkstra负权优化
    Exchanging Gifts--2019CCPC哈尔滨 E题
    A<=B的前提下全排列A使答案尽量大
  • 原文地址:https://www.cnblogs.com/yixiaozi/p/4511218.html
Copyright © 2011-2022 走看看