I'm having trouble with this, hopefully minor issue and I cant seem to figure out how to solve it.
I have a vba script that works well in merging multiple workbook/worksheets into 1. However, the path of the folder is a static path. I'd like to make it a variable that can be defined by a filedialog function.
Here is the existing code for the file merger:
Sub ProjectMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.GetFolder("C:\Users\testUser\Desktop\FolderTest")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
Here is the script to use filedialog:
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
I would think it would be easy enough to replace the folder path string with sItem to get this to work, but doing so always results in errors. Do i have to designate sItem as something else in order use it as the path? I'm not very familiar how Functions work vs regular subs.
You simply need to capture the selected path returned from the function & deal with the possibility of it being empty if the user cancelled the dialog, E.g.
Dim path As String
path = GetFolder()
If (path <> "") Then
Set dirObj = mergeObj.GetFolder(path)
....
....
Else
'// user cancelled
End If
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'm trying to add in a folder selection dialog into my code and I keep getting the run-time error "Object variable or With block variable not set". Honestly, I suspect that the problem is just me being dumb and might be as simple as a typo or me not understanding something simple about this function, but I just can't seem to figure it out.
Dim ofso As Scripting.FileSystemObject
Dim oFolder As Object
Dim oFile As Object
Dim i As Long, colFolders As New Collection, ws As Worksheet
Set ws = Sheets.Add(Type:=xlWorksheet, After:=ActiveSheet)
Set ofso = CreateObject("Scripting.FileSystemObject")
'Set oFolder = ofso.GetFolder("F:\") This is the line to be replaced with the folder picker and what was being used before.
'Start folder picker
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
oFolder = .SelectedItems(1) & "\"
End With
Then the code resumes with everything else that works fine when not using the folder picker thing.
Stepping through the code, it gives the error when it gets to the line
oFolder = .SelectedItems(1) & "\"
Maybe I just need another set of eyes to point out what I'm missing? Or maybe I'm just not understanding something fundamental here (I'm still learning). Either way, I need help.
I also tried playing with my object names
Set oFolder = Application.FileDialog(msoFileDialogFolderPicker)
With oFolder
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Sub 'Check if user clicked cancel button
oFolder = .SelectedItems(1) & "\"
End With
And it still isn't working
Edit: Here is my full code without the folder picker, to show what I'm trying to do.
Sub GetFilesColFunc()
Application.ScreenUpdating = False
Dim ofso As Scripting.FileSystemObject
Dim FldrPicker As FileDialog
Dim oFolder As Object
Dim oFile As Object
Dim i As Long, colFolders As New Collection, ws As Worksheet
Set ws = Sheets.Add(Type:=xlWorksheet, After:=ActiveSheet)
Set ofso = CreateObject("Scripting.FileSystemObject")
Set oFolder = ofso.GetFolder("F:\")
On Error Resume Next
ws.Cells(1, 1) = "File Name"
ws.Cells(1, 2) = "File Type"
ws.Cells(1, 3) = "Date Created"
ws.Cells(1, 4) = "Date Last Modified"
ws.Cells(1, 5) = "Date Last Accessed"
ws.Cells(1, 6) = "File Path"
Rows(1).Font.Bold = True
Rows(1).Font.Size = 11
Rows(1).Borders(xlEdgeBottom).LineStyle = XlLineStyle.xlContinuous
Range("C:E").Columns.AutoFit
colFolders.Add oFolder 'start with this folder
Do While colFolders.Count > 0 'process all folders
Set oFolder = colFolders(1) 'get a folder to process
colFolders.Remove 1 'remove item at index 1
For Each oFile In oFolder.Files
ws.Cells(i + 2, 1) = oFile.Name
ws.Cells(i + 2, 2) = oFile.Type
ws.Cells(i + 2, 3) = oFile.DateCreated
ws.Cells(i + 2, 4) = oFile.DateLastModified
ws.Cells(i + 2, 5) = oFile.DateLastAccessed
ws.Cells(i + 2, 6) = oFolder.Path
i = i + 1
Next oFile
'add any subfolders to the collection for processing
For Each sf In oFolder.SubFolders
If Not SkipFolder(sf.Name) Then colFolders.Add sf 'Skips folders listed within the referenced function
Next sf
Loop
Application.ScreenUpdating = True
End Sub
You are confusing things, probably because you stared at your code for too long :)
I botched together an example for you that hopefully illustrates some of the confusing stuff. Please note: I haven't done VBA in ages
I divided up your problem into a few subsections.
A FileDialog (aka the folderpicker built-in in Office) returns strings. So I put that into its own function.
You cannot simply create an FSO Folder object by assigning a string to it. That is not how objects work, you have to bring them to live with the Set keyword. When you are new to VBS/VBA that is hard to understand at first. The GetFolder method from the Windows Scripting Host's FileSystemObject returns a Folder object. I put the output of that in the GetFSOFolder function. The GetFSOFolder returns an object, so you have to Set the variable (oFolder) that captures it
Without the fluff that you decorated your OP with, here is an example of how you could approach this to just get the oFolder in your OP.
It is probably longer than you want it to be, the reason being that I hope to clarify some things by being elaborate about it.
Sub Main()
Dim sFolder As String
sFolder = FolderPicker() 'get the string representation from FileDialog
If sFolder = "" Then
Debug.Print "No folder was selected"
Exit Sub
End If
'create a Folder object from the string
Dim oFolder As Object
Set oFolder = GetFSOFolder(sFolder)
'what do we have?
Debug.Print "Selected folder was: " & oFolder.path
End Sub
Function GetFSOFolder(path As String) As Object 'returns a Folder object if path is valid
Dim ofso As Scripting.FileSystemObject
Set ofso = CreateObject("Scripting.FileSystemObject")
Set GetFSOFolder = ofso.GetFolder(path) 'note the Set, we are returning an object
End Function
Function FolderPicker() As String 'takes care of the folder picking dialog stuff
Dim FldrPicker As FileDialog
'Start folder picker
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then Exit Function 'Check if user clicked cancel button
FolderPicker = .SelectedItems(1) '.SelectedItems(1) returns a string!
End With
End Function
Instead of providing the file path in my code, I prompt the user to select the folder that contains data files in xlsx format, over which is looped via: For Each wbFile In fldr.Files.
I am getting error 424.
See the commented out lines in the code:
Sub getDataFromWbs()
Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
'Set fldr = fso.GetFolder("\\name_of_folder_to_get_files_from\") 'old code
'Dim FolderName As String 'fldr was previously, original code: FolderName
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
fldr = .SelectedItems(1) 'fldr was previously, original code: FolderName
Err.Clear
On Error GoTo 0
End With
i = "1" 'set integer for loop over sheets
For Each wbFile In fldr.Files 'loop over data in prompted folder
Here's a quick fix of your code:
Sub getDataFromWbs()
Dim wb As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
'Set fldr = fso.GetFolder("\\name_of_folder_to_get_files_from\") 'old code
'Dim FolderName As String 'fldr was previously, original code: FolderName
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Show
On Error Resume Next
FolderName = .SelectedItems(1) 'fldr was previously, original code: FolderName
Err.Clear
On Error GoTo 0
End With
i = "1" 'set integer for loop over sheets
Set fldr = fso.GetFolder(FolderName)
For Each wbFile In fldr.Files 'loop over data in prompted folder
I have written code for opening a PPT presentation on my system and store only the ppt file name in a variable. That ppt file will call one more saved module. My code is given below:
Sub PPTTest()
Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogOpen)
With fldr
.Title = "Select a File"
.AllowMultiSelect = False
.InitialFileName = ""
If .Show <> -1 Then Exit Sub
sItem = .SelectedItems(1)
End With
Set fldr = Nothing
PPT.Presentations.Open sItem, , , False
Filename = Mid$(sItem, InStrRev(sItem, "\") + 1, Len(sItem))
PPT.Run "fileName!Module1.KillSpecificSlide"
End Sub
But after debugging in the line
PPT.Run "fileName!Module1.KillSpecificSlide"
it shows the error
Invalid request. Sub or function not defined.
When I have written the same code as
PPT.Run "BOD.pptx!Module1.KillSpecificSlide"
it works fine. But when I store the same name in a variable and pass it through the code its shows error.
How to resolve this issue?
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