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
Related
How do I call this function with the click of a button.
Is there a way to assign this function to a button?
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
Right-click button then go to "Assign Macro" option, select the Sub that you want to call on click on that button, and click "OK"
You can not assign the function to the button so you need to create a Sub, you can create the sub like this:
Sub ClickBottonSub()
Dim GetFolderPath As String
GetFolderPath = GetFolder
End Sub
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?
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
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
I am trying to have a browse button on an excel sheet by clicking which i can select a file and the path of the selected file will get displayed in a textbox on the same excel sheet.This is the code i have tried:
Dim File_Path As Long
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
GetFolder = .SelectedItems(1)
TextBox1.Value = GetFolder
End With
End Sub
when i run the code,i am able to select a file but then i am getting a runtime error "object required" and the line
TextBox1.Value = GetFolder
is getting highlighted.can anyyone please help me with this.thank you.
Error suggest that you don't have any TextBox object in the Activesheet or Object reference is not complete.
Possible solution (when talking about ActiveSheet):
ActiveSheet.TextBox1.Value = GetFolder
or when talking about any other sheet:
Sheets("NameOfTheSheetHere").TextBox1.Value = GetFolder
Misunderstood the question.
Here is another way.
Replace
TextBox1.Value = GetFolder
with
ActiveSheet.Shapes("Textbox1").OLEFormat.Object.Object.Text = getfolder
In a more structured way...
Sub Button2_Click()
Dim File_Path As Long
Dim shp As Shape
Set shp = ActiveSheet.Shapes("Textbox1")
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
getfolder = .SelectedItems(1)
shp.OLEFormat.Object.Object.Text = getfolder
End With
End Sub
Also instead of Application.FileDialog(msoFileDialogOpen) you may use the inbuilt Application.GetOpenFilename
Private Sub CommandButton1_Click()
Dim Ret
Ret = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If Ret <> False Then _
ActiveSheet.Shapes("Textbox1").OLEFormat.Object.Object.Text = getfolder
End Sub
BTW change "Excel Files (*.xls*), *.xls*" to "All Files (*.*), *.*" if you want to show all files and not just Excel Files.