I'm using CAM software called AlphaCAM which has Visual Basic integrated into its software. I'm trying to run a button within a userform utilizing the file dialog object to return a folder path. However, it does not recognize the FileDialog object and I believe it is because I'm working outside of an office application. Here is my code:
Private Sub Command_FindFolder_Click()
Dim fldr As FileDialog
Dim foldername As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
foldername = .SelectedItems(1)
End With
NextCode:
Set fldr = Nothing
TB_FolderName.Value = foldername
End Sub
I've also tried changing the variable fldr to "Dim fldr As Object" but the code still trips on "Application.FileDialog".
Is there loop hole around this? Can I open an excel window just to run the file dialog?
Thanks for your help!
"Can I open an excel window just to run the file dialog?"
Yes you can:
Private Sub Command_FindFolder_Click()
Dim fldr, xlApp
Dim foldername
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set fldr = xlApp.FileDialog(4) 'msoFileDialogFolderPicker
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = xlApp.DefaultFilePath
If .Show = -1 Then foldername = .SelectedItems(1)
End With
Set fldr = Nothing
xlApp.DisplayAlerts = False
xlApp.Quit
Set xlApp = Nothing
'TB_FolderName.Value = foldername
WScript.Echo foldername
End Sub
I think your intention is something like that:
Sub foo()
Dim shell: Set shell = CreateObject("Shell.Application")
Dim file: Set file = shell.BrowseForFolder(0, "Choose a file:", &H4000)
BrowseForFile = file.self.Pat
End Sub
Related
I'm trying to add a browse button to browse the folder.
Private Sub BrowseButton_Click()
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFilePicker)
With fldr
.Title = “Select a File”
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFile = sItem
Set fldr = Nothing
End Sub
I get
User - defined type is not defined.
I'm using function to set database directory at Excel with FileDialog, But I have to set about 20 different database directory
I set up one of it with SettingsSheet.databaseDirectory0 = sItem, but for the others, I don't want to write the same function for each of them isn't there any
parametric solution to set them to one function?
Function GetFolder() As String
Dim fdo As FileDialog
Dim sItem As String
Set fdo = Application.FileDialog(msoFileDialogFolderPicker)
With fdo
.Title = "Select a Directory"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
SettingsSheet.databaseDirectory0.Value = sItem
End With
NextCode:
GetFolder = sItem
Set fdo = Nothing
End Function
Pass it the control. Something along the lines of this:
Function GetFolder(txt As Control) As String
Dim fdo As FileDialog
Dim sItem As String
Set fdo = Application.FileDialog(msoFileDialogFolderPicker)
With fdo
.Title = "Select a Directory"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
txt.Value = sItem
End With
NextCode:
GetFolder = sItem
Set fdo = Nothing
End Function
This pseudo-code demonstrates how to make the function generic. See how I'm passing the control to the function and then referencing that instead of the databaseDirectory0?
You can return sItem to the parent caller and set
SettingsSheet.databaseDirectory0n.Value = functionName(txt as Control)
Does this make sense?
my code prompts user to save the current file as a macro free file, the problem is that if the user hits cancel then i get an error. i need my code to start over when the user hits cancel. so it would be best if a message box pops up and says please select location to save file and then the dialog box pops up again so the user can select where to save file, and if user hits cancel again then just exit.
Sub SaveWithoutMacro()
Dim objFolder As Object, objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(ChooseFolder)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=objFolder & "\" & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) & ".xlsx", FileFormat:=51, password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
If objFolder <> False Then Exit SaveWithoutMacro = objFolder
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function ChooseFolder() As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder to save down the copy of this workbook"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
ChooseFolder = sItem
Set fldr = Nothing
End Function
If you want to avoid the error you have on "Cancel" (coming from the fact that you execute Set objFolder = objFSO.GetFolder(ChooseFolder) on an empty string (since ChooseFolder() returns empty if the user cancels the action) and at the same time ask him twice - why'd you want to ask them twice? - then you should write your macro like this:
Sub SaveWithoutMacro()
folderPath = ChooseFolder() '<-- ask them to select once
If folderPath = "" Then '<-- if they clicked cancel once
MsgBox "You didn't select a folder", vbCritical, "Are you sure?" '<-- message box to inform them
folderPath = ChooseFolder() '<-- ask them again to select
If folderPath = "" Then Exit Sub '<-- if again empty, then exit procedure
End If
'rest of your save code
I dont recommend doing this as it can really annoy the user, but basically you just put it into a Do Loop - something like this (untested)
With fldr
.Title = "Select a Folder to save down the copy of this workbook"
.AllowMultiSelect = False
.InitialFileName = strPath
Do Until .Show <> -1
If .SelectedItems(1) <> "" Then GoTo NextCode
Loop
End With
NextCode:
ChooseFolder = .SelectedItems(1)
I'm trying to get the path for a folder using the filedialog.show function.
The issue I am facing is:
After I select a folder in the folderpicking window the code does not continue. It either restarts or it ends without anything happening.
What could be the problem?
[...]
Dim fpath As Variant
Dim fldr As Object
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Title = "Select a Folder"
fldr.AllowMultiSelect = False
fldr.InitialFileName = Application.DefaultFilePath
If fldr.Show = -1 Then
fpath = fldr.SelectedItems(1)
Else
GoTo NextCode
End If
NextCode:
set fldr = Nothing
[...]
It works, you are just not using it to display the path result (or return a String value from this Sub).
Change your code:
If fldr.Show = -1 Then
fpath = fldr.SelectedItems(1)
Else
GoTo NextCode
End If
NextCode:
set fldr = Nothing
To:
If fldr.Show = -1 Then
fpath = fldr.SelectedItems(1)
MsgBox fpath ' <-- for DEBUG
End If
Set fldr = Nothing
If you want to use your code as a Function that returns the path of the selected folder, use the code below:
Function GetFolderPath() As String
Dim fpath As Variant
Dim fldr As Object
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Select a Folder"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show = -1 Then
GetFolderPath = .SelectedItems(1)
End If
End With
Set fldr = Nothing
End Function
And the Sub code to test it:
Sub Test()
Dim FolderPath As String
FolderPath = GetFolderPath
MsgBox FolderPath
End Sub
There is a ready script that counts number of rows in Workbooks from a selected folder. In case number of rows in any workbook is more than 1, this workbook is copied and saved into another folder.
Sub OpenFiles()
Dim MyFolder As String
Dim MyFile As String
Dim TargetWB As Workbook
MyFolder = GetFolder("C:\Users\user\Desktop")
MyFile = Dir(MyFolder & "*.*")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Do While MyFile <> ""
Set TargetWB = Workbooks.Open(Filename:=MyFolder & "\" & MyFile & "*.*")
With TargetWB
If CountUsedRows(TargetWB) > 1 Then
.SaveAs "C:\Users\user\Desktop\vba\" & MyFile
End If
.Close
End With
MyFile = Dir
Loop
'Workbooks.Close savechanges:=False
Shell "explorer.exe C:\Users\user\Desktop\vba", vbMaximizedFocus
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Function GetFolder(strPath As String) As String
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:
GetFolder = sItem
Set fldr = Nothing
End Function
Function CountUsedRows(Wbk As Workbook) As Long
Dim WS As Worksheet
Set WS = Wbk.Sheets(1)
CountUsedRows = WS.Range("A" & Rows.Count).End(xlUp).Row
End Function
Is it possible to move a Worbook to another folder insted of coping it in case it contains more than 1 row.
And is it possible to use something like: Workbooks.Close savechanges:=False in order to close chosen Workbooks after rows counting? Thanks!
You can move a file easily using the MoveFile method of FileSystemObject object. To use this type with early binding add a reference to Microsoft Sripting Runtime in your VBA project.