My code should loop through Folders/Subs and determine if there is any file there.
I have 2 questions:
I am not getting any feedback if there are NO Folders/Subs in certain Folders. A specific case: If it detects files (not Folders), assume there are some files (Excel for instance) in it the program says "Empty Folder"?
On the Open Window dialog to select a Folder, if I click Cancel it gives me a Popup window stating: "Folder not empty..blabla..."
Sub Button1_click()
Dim FileSystem As Object
Dim HostFolder As String
Dim Answer As String
Dim fs, strFolderPath, oFolder
' *** Folder with Files to perform an action ***
HostFolder = GetSourceFolder()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
' *** This is your folder to define ***
Set fs = CreateObject("Scripting.FileSystemObject")
strFolderPath = Application.ActiveWorkbook.Path
Set oFolder = fs.getfolder(strFolderPath)
If (oFolder.SubFolders.Count = 0) Then
' *** If folder is empty/full message ***
' * Folder is Empty *
MsgBox "Folder is empty!", vbOKOnly + vbInformation, "Information!"
Else
' * Folder isn't empty *
Answer = MsgBox("Folder not empty! Proceed with Macro?", vbYesNo + vbInformation + vbDefaultButton1, "Information!")
If Answer = vbNo Then Exit Sub
End If
Set fs = Nothing
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Dim targetFolder As String
targetFolder = GetTargetFolder()
DoFolder FileSystem.getfolder(HostFolder)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Function GetSourceFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select Source Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetSourceFolder = sItem
Set fldr = Nothing
End Function
Function GetTargetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select Output Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetTargetFolder = sItem
Set fldr = Nothing
End Function
If you want to make separate procedure for selecting folder, you need to determine whether user selected anything. You can use Boolean return type of the function as a result of action and string for source folder which is passed by reference, which will be filled if user selected folder. Here's the basic code:
Sub Test()
Dim sourceFolder As String
'// Usage
If Not GetSourceFolder(sourceFolder) Then
MsgBox "No folder selected", vbExclamation
Exit Sub
End If
'// Go on with your code
End Sub
Function GetSourceFolder(ByRef sourceFolder As String) As Boolean
'// By default function will return False
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then
sourceFolder = .SelectedItems(1)
GetSourceFolder = True
End If
End With
End Function
Related
Trying to get clarification on an older post. Is there a way to call the choosefolder function in several different subroutines and not have the pop up window each time it is called. Basically trying to reuse the folder path selected initially to run different subroutines using that path.
Here is a sample of the code of found. I was able to get the base to work, but can't pass it into the 3 different subroutines that would call on the choose folder.
VBA - selecting a folder and referencing it as the path for a separate code
Make ChooseFolder() into a function and then reference it:
Public Function ChooseFolder()
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
Private Sub btn_LeaveReport()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim sFldr As String
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
sFldr = ChooseFolder()
Set objFolder = objFSO.GetFolder(sFldr)
i = 3
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 2) = objFile.Name
'print file path
Cells(i + 1, 3) = objFile.Path
i = i + 1
Next objFile
End Sub
Like this:
Sub Main()
Dim fldr As String
fldr = ChooseFolder()
If Len(fldr) > 0 Then
PartOne fldr
PartTwo fldr
PartThree fldr
Else
MsgBox "No folder selected"
End If
End Sub
Sub PartOne(fldr as String)
'use fldr
End Sub
Sub PartTwo(fldr as String)
'use fldr
End Sub
Sub PartThree(fldr as String)
'use fldr
End Sub
I want to prompt the user to select the folder path with FileDialog and integrate it with a routine which imports the desired files to the open workbook.
Below is my code but rather than pre-determining the folderpath I need to prompt the user:
Sub MergeCsvFilesToWb()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Dim fldr As FileDialog
Application.ScreenUpdating = False
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select the Folder where the '.csv' files are located."
.AllowMultiSelect = False
.Show
End With
FolderPath = fldr.SelectedItems(1)
Filename = Dir(FolderPath & "*.csv*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
The File/Folder selected in FileDialog can be found in the SelectedItems property (Documentation)
So to assign the variable FolderPath to the selected folder:
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select the Folder where the '.csv' files are located."
.Show
Dim FolderPath As String
FolderPath = .SelectedItems(1)
End With
Note that you should handle the event that the user does not select any folder (click Cancel) in the dialog so a better version would be:
Dim fldr As FileDialog
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select the Folder where the '.csv' files are located."
.Show
Dim FolderPath As String
If .SelectedItems.Count <> 0 Then
FolderPath = .SelectedItems(1)
Else
'Code to handle event that nothing is selected
'e.g.
'Exit Sub
End If
End With
Lastly, the folder path returned does not have a slash at the end so you will need to either:
Modify Filename = Dir(FolderPath & "*.csv*") to Filename = Dir(FolderPath & "\*.csv*")
Modify FolderPath = .SelectedItems(1) to FolderPath = .SelectedItems(1) & "\"
I am trying to give users the option to 'set' a default folder location, this would only be used to prefill further userform text boxes to save time having to go through the msoFileDialogFolderPicker
I did use chdir, but that was written into the vba script, this location will differ from user to user and should only need to be set once upon addon installation
This is the code for the master folder selector:
Private Sub cmdfoldsel_Click()
On Error GoTo err
Dim fileExplorer As FileDialog
Set fileExplorer = Application.FileDialog(msoFileDialogFolderPicker)
'To allow or disable to multi select
fileExplorer.AllowMultiSelect = False
With fileExplorer
If .Show = -1 Then 'Any folder is selected
tbmasterloc.text = .SelectedItems.Item(1)
Else ' else dialog is cancelled
MsgBox "You have cancelled the dialogue"
[folderPath] = "" ' when cancelled set blank as file path.
End If
End With
err:
Exit Sub
End Sub
It is letting me choose the folder, but obviously the text disappears when I close ( I was using a close button with unload me but i thought that was deleting the text
An example of the second userform which will call that folder location is here:
Private Sub UserForm_Initialize()
copyfromtb.Value = mfs.tbmasterloc.text
End Sub
Private Sub copyfromcmd_Click()
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
'.InitialFileName = Application.GetSaveAsFilename()
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
copyfromtb.Value = sItem
Set fldr = Nothing
End Sub
I have a function that prompts the user to select a folder and a subroutine that will consolidate the files in the folder to a single document, but I cannot get the two to work together.
Function GetFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function
Sub ConslidateWorkbooksPrompt()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = GetFolder()
Filename = Dir(FolderPath & "*.csv")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub
When I save the subroutine separately and run it where FolderPath = "C:\docs\SampleFolder\" then it runs fine. Instead of having to manually change the folder path, I'd like the user to be able to select their own, but I imagine I am somehow calling the function wrong.
So my code works before I put in the end if, but once I try to implement the condition for if cancel is selected, I get a "else without if " compile error or something like that. I'm basically trying to do this:
This is the portion of my code that I'm talking about:
Public Function ChooseFolder()
'Declaring variables
Dim fldr As FileDialog
Dim sItem As String
'Folder selection
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
Else
MsgBox ("You did not select any folders")
End If
End With
End Function
Ok so the above has been fixed thanks to your help. What error I'm getting now (although it doesn't prevent the code from working is in this segment:
Private Sub btn_LeaveReport()
'Declaring variables
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim sFldr As String
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Added this bc of stack overflow advice. Basically how to reference path via string
sFldr = ChooseFolder()
Set objFolder = objFSO.GetFolder(sFldr)
'Hardcoded version commented out since the above choose folder option is available
'Set objFolder = objFSO.GetFolder("D:\Administration\Time Sheets")
i = 3
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 2) = objFile.Name
'print file path
Cells(i + 1, 3) = objFile.Path
i = i + 1
Next objFile
End Sub
For some reason the Set objFolder is creating a runtime error regarding an invalid procedure call. However, the program still works so I'm confused what the issue is.
The problemis the line
If .Show <> -1 Then GoTo NextCode
In VBA this is already a complete IF clause, so the later ELSE and End If are missing the starting IF clause.
Is this what you are trying?
Public Function ChooseFolder()
'Declaring variables
Dim fldr As FileDialog
Dim sItem As String
'Folder selection
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show = -1 Then
sItem = .SelectedItems(1)
ChooseFolder = sItem
Else
MsgBox ("You did not select any folders")
End If
End With
Set fldr = Nothing
End Function