There are probably better ways to do it, but here is a section of code I was
using to iterate through files on sharepoint and create a list of hyperlinks
in Excel.
Follow this link-
http://www.pcreview.co.uk/forums/access-sharepoint-via-vba-t3857908.html
Option Explicit
Global asd 'variant 1-D array
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 = "\\share.companyname.com\directory\folder\"
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