Option Explicit
Sub btnSharePointFolder()
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("SharePoint Download")
If sht.Range("SharePointPath") = "" Then
MsgBox "Please enter a sharepoint path first", vbCritical
Exit Sub
End If
If Right(sht.Range("SharePointPath"), 1) <> "/" Then
'SharePointPath: http://testdrive.sharepoint.ckannan.blogspot.com/teams/YourTeam/
sht.Range("SharePointPath") = sht.Range("SharePointPath") & "/"
End If
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = sht.Range("SharePointPath")
.Title = "Please select a location of input files"
.Show
If Not .SelectedItems.Count = 0 Then
sht.Range("SharepointFolder") = .SelectedItems(1)
Else
Exit Sub
End If
End With
' 'To Remove Drive
' Shell "net use Q: /delete"
If Dir("Q:\", vbDirectory) = "" Then
Shell "net use Q: " & sht.Range("SharePointPath").Value '/user:MyDomain\MyUserName MyPassword
End If
End Sub
'_________________________________________________________________________________
Sub MapNetworkDrive()
If Dir("Q:\", vbDirectory) = "" Then
'SharePointPath: http://testdrive.sharepoint.ckannan.blogspot.com/teams/YourTeam/
Shell "net use Q: " & ThisWorkbook.Sheets("SharePoint Download").Range("SharePointPath").Value '/user:MyDomain\MyUserName MyPassword
MsgBox "The sharepoint path is mapped as network drive.", vbInformation
Else
MsgBox "The mapped network drive already exists.", vbInformation
End If
End Sub
'_________________________________________________________________________________
Sub DownloadFiles()
Dim Directory As String
Dim file As String
Dim i As Long
Dim fso As FileSystemObject
Application.ScreenUpdating = False
If Dir("Q:\", vbDirectory) = "" Then
MsgBox "There is no mapped network drive", vbCritical
Exit Sub
End If
'DownloadFolder: http://testdrive.sharepoint.ckannan.blogspot.com/teams/YourTeam/Shared Documents/PDW Status
Directory = "Q:\" & ThisWorkbook.Sheets("SharePoint Download").Range("DownloadFolder").Value & "\"
Set fso = CreateObject("Scripting.FileSystemObject")
' Get first file
file = Dir(Directory, vbReadOnly + vbHidden + vbSystem)
If file = "" Then
MsgBox "No files found in the sharepoint folder.", vbCritical
Exit Sub
End If
Do While file <> ""
fso.CopyFile Directory & file, "C:\", True
file = Dir()
Loop
Application.StatusBar = False
MsgBox "Downloaded all files to the local folder.", vbInformation
End Sub
'_________________________________________________________________________________
Sub btnLocalFolder_Click()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Please select a location to download files"
.Show
If Not .SelectedItems.Count = 0 Then
ThisWorkbook.Sheets("SharePoint Download").Range("LocalFolder") = .SelectedItems(1)
End If
End With
End Sub