none
Sharepoint List to Excel Without downloading Data using VBA RRS feed

  • Question

  • Hi

    I am in need of a VBA code in Excel to get the number of entries in a sharepoint list. Please note that I don't want to download the whole list since there are more than 10000 entries.

    Thanks

    Jithin

    Wednesday, July 1, 2015 9:47 AM

All replies

  • I haven't used SharePoint in at least 5+ years, and I don't have access to it now, but I think something like this will work for you.

    Sub SrchForFiles()
    ' Searches the selected folders and sub folders for files with the specified (xls) extension.
    'ListTheFiles 'get the list of all the target XLS files on the SharePoint Directory
    
    Dim i As Long, z As Long, Rw As Long, ii As Long
    Dim ws As Worksheet, dd As Worksheet
    Dim y As Variant
    Dim fldr As String, fil As String, FPath As String
    Dim LocName As String
    Dim FString As String
    Dim SummaryWB As Workbook
    Dim SummaryWS As Worksheet
    Dim Raw_WS As Worksheet
    Dim LastRow As Long, FirstRow As Long, RowsOfData As Long
    Dim UseData As Boolean
    Dim FirstBlankRow As Long
    
    'grab current location for later reference, for where to paste final data
    Set SummaryWB = Application.ActiveWorkbook
    Set SummaryWS = Application.ActiveWorkbook.ActiveSheet
    
    y = "xls"
    fldr = "\\excel-pc:43231\Shared%20Documents\Forms\AllItems.aspx"
    FirstBlankRow = 2
    
    'asd is a 1-D array of files returned
    asd = ListFiles(fldr, True)
    
    Set ws = Excel.ThisWorkbook.Worksheets(1) 'list of files
    ws.Activate
    ws.Range("A1:Z100").Select
    Selection.Clear
    
    On Error GoTo 0
    For ii = LBound(asd) To UBound(asd)
    Debug.Print Dir(asd(ii))
    
    fil = asd(ii)
    
    'open the file and grab the data
    Application.Workbooks.Open (fil), False, True
    
    'Get file path from file name
    FPath = Left(fil, Len(fil) - Len(Split(fil, "\")(UBound(Split(fil, "\")))) - 1)
    'Get file information
    If Left$(fil, 1) = Left$(fldr, 1) Then
    If CBool(Len(Dir(fil))) Then
    z = z + 1
    ws.Cells(z + 1, 1).Resize(, 6) = _
    Array(Dir(fil), LocName, RowsOfData, Round((FileLen(fil) / 1000), 0), FileDateTime(fil), FPath)
    DoEvents
    With ws
    .Hyperlinks.Add .Range("A" & CStr(z + 1)), fil
    '.FoundFiles(i)
    End With
    End If
    End If
    
    'Workbooks.Close 'Fil
    Application.CutCopyMode = False 'Clear Clipboard
    Workbooks(Dir(fil)).Close SaveChanges:=False
    Next ii
    
    With ws
    Rw = .Cells.Rows.Count
    With .[A1:F1]
    .Value = [{"Full Name","Location","Rows of Data","Kilobytes","Last Modified", "Path"}]
    .Font.Underline = xlUnderlineStyleSingle
    .EntireColumn.AutoFit
    .HorizontalAlignment = xlCenter
    End With
    .[G1:IV1 ].EntireColumn.Hidden = True
    On Error Resume Next
    'Range(Cells(Rw, "A").End(3)(2), Cells(Rw, "A")).EntireRow.Hidden = True
    Range(.[A2 ], Cells(Rw, "C")).Sort [A2 ], xlAscending, Header:=xlNo
    End With
    
    End Sub
    
    Function ListFiles(ByVal Path As String, Optional ByVal NestedDirs As Boolean) _
    As String()
    Dim fso As New Scripting.FileSystemObject
    Dim fld As Scripting.folder
    Dim fileList As String
    
    ' get the starting folder
    Set fld = fso.GetFolder(Path)
    ' let the private subroutine do all the work
    fileList = ListFilesPriv(fld, NestedDirs)
    ' (the first element will be a null string unless the first ";" is removed)
    fileList = Right(fileList, Len(fileList) - 1)
    ' convert to a string array
    ListFiles = Split(fileList, ";")
    
    End Function
    
    ' private procedure that returns a file list
    ' as a comma-delimited list of files
    
    Function ListFilesPriv(ByVal fld As Scripting.folder, _
    ByVal NestedDirs As Boolean) As String
    Dim fil As Scripting.File
    Dim subfld As Scripting.folder
    
    ' list all the files in this directory
    For Each fil In fld.Files
    'If UCase(Left(Dir(fil), 5)) = "MULTI" And fil.Type = "Microsoft Excel Worksheet" Then
    If fil.Type = "Microsoft Excel Worksheet" Then
    ListFilesPriv = ListFilesPriv & ";" & fil.Path
    Debug.Print fil.Path
    End If
    Next
    
    ' if requested, search also subdirectories
    If NestedDirs Then
    For Each subfld In fld.SubFolders
    ListFilesPriv = ListFilesPriv & ListFilesPriv(subfld, NestedDirs)
    Next
    End If
    
    End Function
    
    


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    Thursday, July 2, 2015 3:48 PM
  • Or, something like this.

    Sub ListFiles()
        Dim folder As Variant
        Dim f As File
        Dim fs As New FileSystemObject
        Dim RowCtr As Integer
        Dim FPath As String
        Dim wb As Workbook
        
        RowCtr = 1
        
        FPath = "http://excel-pc:43231/Shared Documents"
        For Each f In FPath
        'Set folder = fs.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
        'For Each f In folder.Files
           Cells(RowCtr, 1).Value = f.Name
           RowCtr = RowCtr + 1
        Next f
    End Sub
    
    Sub Create()
        EnableReference
        CreateList
    End Sub
    Private Sub EnableReference()
     
    On Error Resume Next
    ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\system32\scrrun.dll"
    On Error GoTo 0
    End Sub
    Private Sub CreateList()
        Dim folder As folder
        Dim f As File
        Dim fs As New FileSystemObject
        Dim RowCtr As Integer
        RowCtr = 1
        Set folder = fs.GetFolder("http://excel-pc:43231/Shared Documents/Forms/") '<=Variable Location
        For Each f In folder.Files
           Cells(RowCtr, 1).Value = f.Name
           RowCtr = RowCtr + 1
        Next f
    End Sub
    
    Sub ListAllFile()
    
     Dim objFSO As Object
     Dim objFolder As Object
     Dim objFile As Object
     Dim pth As String
     Dim WBn As Workbook
     Dim ObCount As Long
     Dim FileNme As String
    
     Application.ScreenUpdating = False
    
     Set objFSO = CreateObject("Scripting.FileSystemObject")
    
     'Get the folder object associated with the directory
     Set objFolder = objFSO.GetFolder("\\excel-pc:43231\Shared Documents\Forms\")
    '** You'll need to specify your path here. By removing the http: from the path, the code liked it & found the folder. It wasn’t working previously ***
    
     pth = "http://excel-pc:43231/Shared Documents/Forms/"
    '** You'll need to specify your path here. The reason I’ve done this separately is because the path is not recognised otherwise when trying to specify it with workbook.open & using the value set for objFolder **
    
     ObCount = objFolder.Files.Count
    '** counts the number of files in the folder
    
     'Loop through the Files collection
     For Each objFile In objFolder.Files
     Nm1 = Len("http://excel-pc:43231/Shared Documents/Forms/")
    '** You'll need to specify your path here **
     Nm2 = Len(objFile) - Nm1
     FileNme = Right(objFile, Nm2)
    '** I’ve done this part to find out/set the file name**
    
     Set WBn = Workbooks.Open(pth & FileNme, , , , Password:="yourpassword")
    '** opens the first file in the library – if there is no password, the remove everything from - , , , , Password:="Password1" – leaving the close bracket ‘)’
    
     Application.ScreenUpdating = False
    '** optional – you can leave the screen updating on
    
    '<< Your coding here>>
    '** The file is now open. Enter whatever code is specific to your spreadsheets.
    
     Next
    '** goes to next file within your sharepoint folder
    
    End Sub
    


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    Thursday, July 2, 2015 3:49 PM