How to traverse folders and files on SharePoint with Excel VBA

[pczegle]

I have done many searches on how to traverse all files in SharePoint folders using Excel VBA and have not come across an answer I could use because, by configuration design, I cannot map a SharePoint URL to a drive letter. After much trial and error, I came up with a very short solution that works for me. I'd like to share it in thanks for all the help I have gotten by searching forums like this one. I hope it helps you get home to your kids a little sooner. Here it is:

Sub SPDir()
Dim wb As Workbook
Dim dummyFile As String
'
' The file specified by dummyFile must reside in SharePoint in order to use SharedWorkspace
' The way the code is set up, the path and filename in dummyFile should NOT substitute %20 instead of spaces
' There is logic later to ignore dummyFile on output
' Substitute your own dummy file name below
' If you don't want to create a dummy file on SharePoint, pick any file that's already there
' and get rid of the logic below that ignores it.
'
dummyFile = "https://........"
Set wb = Workbooks.Open(dummyFile)
Application.Wait Now + TimeValue("00:00:01") ' if this code terminates abnormally, try a longer wait value
Set swsFiles = wb.SharedWorkspace.Files
For Each c In swsFiles
'
' The Path logic below limits traversing to just the folder that contains
' dummyFile and all its sub-folders. This can be changed to suit needs.
'
If Replace(c.URL, "%20", " ") <> dummyFile And _
Left(Replace(c.URL, "%20", " ") , Len(wb.Path)) = wb.Path Then MsgBox (c.URL)
Next c
End Sub

 

[dhancy]

Hi, i found this KB related to this issue , i hope.

An ADO-based application that is compiled in Windows 7 SP1 or in Windows Server 2008 R2 SP1 does not run in earlier versions of Windows

still, no use for me. you can give a try. it may help.

It looks like this addresses the reverse situation - where the application runs on Windows 7, but not earlier versions (granted, I only read the first paragraph or so).

In the meantime, I'll keep searching. If I find anything, I'll be sure to post it. It's good to know that others are having the same problem. At first I thought maybe I was the only one, which is probably why I didn't spend too much time lookinng. With two of us looking into this, we're likely to find a solution more quickly!

 

[dhancy]

Please be aware that depending on how you implement this code, you might experience error codes or silently omitted subfolders if you have entitlement issues with any Sharepoint subfolder in the hierarchy. To avoid these errors, make sure that you have the proper entitlements to ALL subfolders or else use appropriate error handling to ignore them.

Prior to Windows 7, this worked great! Ever since I started using Windows 7, I began having issues.

When It gets to this code...

davDir.Open "", _
tempURL, _
adModeReadWrite, _
adFailIfNotExists, _
adDelayFetchStream '_

it throws this error:

Number: -2147217895
Description: Object or data matching the name, range, or selection criteria was not found within the scope of this operation.

Any idea what causes this? Or how to fix it?

Thanks in advance!!


Dennis

 

[dhancy]

I don't know what's causing this error; however, I found another method.

I had to include Microsoft Scripting Runtime in Tools/References to get this to work:

Dim RowCtr As Integer
Dim Folder As Folder
Dim f As File
Dim fs As New FileSystemObject

Public Sub ListFiles
    
    Dim startFolder As String
        
'--------------------------
' startFolder is the Sharepoint Site for which the file tree is produced.
'--------------------------

    startFolder = "<insert your folder name here>"  ' [URL="file://\\xxxx\xxx\etc"]\\xxxx\xxx\etc[/URL]\...
    Cells(1, 1) = "File"
    Cells(1, 2) = "Path in " & startFolder
    Cells(1, 3) = "Last Modified"

    RowCtr = 2
    Set Folder = fs.GetFolder(startFolder)
    For Each f In Folder.Files
       Application.StatusBar = "Row: " & RowCtr
       Cells(RowCtr, 1).Value = f.Name
       Cells(RowCtr, 2).Value = f.Path
       Cells(RowCtr, 3).Value = f.DateLastModified
       
       RowCtr = RowCtr + 1
    Next f
    
    ShowSubFolders fs.GetFolder(startFolder)    
    
    Cells.Select
    Cells.EntireColumn.AutoFit
    
    Application.StatusBar = ""
    
    MsgBox "Number of files found: " & RowCtr - 2
End Sub


Sub ShowSubFolders(Folder)

    For Each Subfolder In Folder.SubFolders
        Set Folder = fs.GetFolder(Subfolder.Path)
        Set colFiles = Folder.Files
        For Each objfile In colFiles
            Application.StatusBar = "Row: " & RowCtr
            Cells(RowCtr, 1).Value = objfile.Name
            Cells(RowCtr, 2).Value = objfile.Path
            Cells(RowCtr, 3).Value = objfile.DateLastModified
            RowCtr = RowCtr + 1
        Next
        ShowSubFolders Subfolder
    Next
End Sub

Hopefully this works for you as well as it worked for me.


Dennis