Access to sharepoint via VBA?

L

luvgreen

Greetings! Is it possible to access sharepoint folder and download all excel
file under a that folder via VBA? Thanks.
 
K

ker_01

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. Hopefully I didn't accidently delete any useful code, but this
should at least get you started.

HTH,
Keith

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
 
L

luvgreen

Thank you so much for your help. Do you need to use sharepoint.dll? How were
you able to connect to share point from your PC using fldr =
"\\share.companyname.com\directory\folder\"? How to solve the user login to
the share point folder? Sorry about my ignorant questions, but I don't know
how to solve those.

Thanks much!


ker_01 said:
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. Hopefully I didn't accidently delete any useful code, but this
should at least get you started.

HTH,
Keith

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


luvgreen said:
Greetings! Is it possible to access sharepoint folder and download all excel
file under a that folder via VBA? Thanks.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top