Private Sub ButtonPath_Click()
Cells(1, 32).Value = FolderExplorer()
End Sub
Above is my UserForm's Code.
Below Code is My Module's FolderExplorer() Function.
'//Source : http://software-solutions-online.com/vba-folder-dialog/ , edited by me.
Public Function FolderExplorer()
Dim intResult As Integer
Dim strPath As String
Application.FileDialog(msoFileDialogFolderPicker).ButtonName _
= "Select Path"
'the dialog is displayed to the user
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog.
If intResult <> 0 Then
'dispaly message box
'Call MsgBox(Application.FileDialog(msoFileDialogFolderPicker _
).SelectedItems(1), _
vbInformation, "Selected Folder")
FolderExplorer() = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
End Function
It seemed working well at first. When I press the button in userform, FolderExplorer Pops up. but when I select the folder path, the Folder Explorer pops up again, and when I select the folder path, the Folder Explorer pops up again.... eternally.
I have no loop in my code. How Can I solve this problem?
Thanks for your answer in advance.
You are calling FolderExplorer() recursively in FolderExplorer() = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1).
You should use FolderExplorer = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) to return the value.
Below is a simplified version of your code.
Public Function FolderExplorer()
Dim intResult As Integer
Dim strPath As String
With Application.FileDialog(msoFileDialogFolderPicker)
.ButtonName = "Select Path"
intResult = .Show
If intResult <> 0 Then
FolderExplorer = .SelectedItems(1)
End If
End With
End Function
Related
Edit : Sorry i forgot to mention that is VBA for Excel
First time i post on this sub reddit. I would like to something very simple, yet I have no heckin idea how to do it.
Let me give you a bit of context : In my company we have a standard model tool, which uses a standard excel file as input.
When you want to update your inputs from an old template, you download a standard file from a platform, and use a sub that doesn't take any arguments (called "upgrade engine"). Wen you call Upgrade engine, there is a file dialog tab that opens, and helps you select the source file you want to upgrade.
I am in a testing team for the standard model and i have to create a lot of templatse for each new release of the model for non regression testing purpose. So i would like to automatize the process. I cannot , and this is the important detail here, change the code of the standard template.
So i created a kind of masterfile with all my non regression test use cases, their address etc to update them one by one.
Here is my current code:
Public gParamTab As Variant
Public gHypTab As Variant
Public gSourcefolder As String
Public gBlankFolder As String
Public gTgtfolder As String
Public Const gParamTabColUseCase As Byte = 1
Public Const gParamTabColTTtgt As Byte = 2
Public Const gParamTabColTTSource As Byte = 3
Public Const gParamTabColFlagRetrieve As Byte = 4
Public Const gParamTabColTTCase As Byte = 5
Public Const gParamTabColFlagUpgrade As Byte = 6
Public Const gBlankTTName As String = "Table_Template_MVP_case"
Public Const gExtension As String = ".xlsb"
Sub init()
gParamTab = Sheets("Parameters").Range("gParamTab")
gHypTab = Sheets("NDD HYP").Range("gHypTab")
gSourcefolder = Sheets("Parameters").Range("gSourcefolder")
gTgtfolder = Sheets("Parameters").Range("gTgtfolder")
gBlankFolder = Sheets("Parameters").Range("gBlankFolder")
End Sub
Sub updateTT()
Call init
Dim lFullname_blank As String, lFullname_source As String, lFullname_tgt As String
Dim lGlobalrange As Variant
Dim lGlobaltable() As Variant
Dim lBlankTT As Workbook
Dim lLastRow As Long
Dim lSearchedVariable As Variant
Dim lBlankTTupgradeengine As String
lcol = 2
For lUsecase = 2 To UBound(gParamTab, 1)
If gParamTab(lUsecase, gParamTabColFlagUpgrade) = 1 Then
lFullname_blank = gBlankFolder & "\" & gBlankTTName & gParamTab(lUsecase, gParamTabColTTCase) & gExtension
lFullname_source = gSourcefolder & "\" & gParamTab(lUsecase, gParamTabColTTSource) & gExtension
lFullname_tgt = gTgtfolder & "\" & gParamTab(lUsecase, gParamTabColTTtgt) & gExtension
Set lBlankTT = Workbooks.Open(lFullname_blank)
lBlankTTupgradeengine = gBlankTTName & gParamTab(lUsecase, gParamTabColTTCase) & gExtension & "!UpgradeEngine.UpgradeEngine"
Application.Run lBlankTTupgradeengine
End If
Next
End Sub
So i come the main issue, how can I, from another macro, after the statement "Application.Run lBlankTTupgradeengine" , the upgrade engine macro starts, and calls the following function embedded in the "BlankTT" :
Sub UpgradeEngine()
Set wkb_target = ThisWorkbook
Set wkb_source = macros_Fn.Open_wkb()
[...]
Function Open_wkb() As Workbook
Dim fileName As Variant
With Application.FileDialog(msoFileDialogFilePicker)
' Makes sure the user can select only one file
.AllowMultiSelect = False
' Filter to just keep the relevants types of files
.filters.Add "Excel Files", "*.xlsm; *.xlsb", 1
.Show
' Extact path
If .SelectedItems.Count > 0 Then
fileName = .SelectedItems.Item(1)
Else
End
End If
End With
If (fileName <> False) Then
Set Open_wkb = Workbooks.Open(fileName:=fileName, IgnoreReadOnlyRecommended:=False, Editable:=False, ReadOnly:=True, UpdateLinks:=False)
Else
MsgBox "This file is already open. Please close it before launching the function."
End
End If
End Function
This function opens as I said before, a dialog box with a brows button to select the excel spreadsheet to use as ssource.
My question is, how can i fill automatically this Filedialog from my code, without changing the code of the standard excel file?
Thanks a lot for your help!
I tried to search everywhere but i did not find anything about this situation.
I'm trying to move a copy of the upgrade engine, but with an argument in the sub instead of the filedialog but the macro is too complex ..
Your best bet would be to add an optional parameter to UpgradeEngine - something like:
Sub UpgradeEngine(Optional wbPath as String = "")
'...
Set wkb_target = ThisWorkbook
If Len(wbPath) > 0 Then
Set wkb_source = Workbooks.Open(wbPath) 'open using provided file path
Else
Set wkb_source = macros_Fn.Open_wkb() 'open user-selected file
End If
'...
'...
Then you can call it and pass in the path you want.
FYI the code in Open_wkb seems off (at least, the "already open" message seems wrong). fileName <> False only checks if the user made a selection: it doesn't indicate anything about whether a selected file is already open or not.
I am struggling with Workbooks(). In the below code I want the user to pick the file and get the path file from the dialogbox. All these steps are working. However I am struggling the use pathKeys. It seems when I write Workbooks(pathkeys) I have an error 9 (Script our of range).
Sub getData()
Dim diagBoxkeys As FileDialog
Dim pathKeys As String
Set diagBoxkeys = Application.FileDialog(msoFileDialogFilePicker)
diagBoxkeys.Title = "Keys File " & FileType
diagBoxkeys.Filters.Clear
diagBoxkeys.Show
If diagBoxkeys.SelectedItems.Count = 1 Then
pathKeys = diagBoxkeys.SelectedItems(1)
End If
MsgBox (pathKeys)
Dim wbKeys As Workbook
ScreenUpdating = False
Set wbKeys = GetObject(pathKeys)
Workbooks(pathKeys).Worksheets(1).Columns(2).Copy Destination:=Workbooks("Macro_PORTAL_APRR.xlsm").Worksheets(1).Columns(1)
wbKeys.Close Savechanges:=False
End Sub
However when in this code I replace Workbooks(pathKeys) with Workbooks("Keys_2021-12-27_13_43_21_utf-8.csv") it works perfectly.
I don't understand why pathKeys is not accepted as pathKeys = C:\Users\tn5809\Documents\PROJETS\PORTAL_APRR\Keys_2021-12-27_13_43_21_utf-8.csv
What am I doing wrong ?
This might work better for you.
'This should appear at the top of all modules.
'It forces you to declare all variables.
'Tools ~ Options ~ Require Variable Declaration.
Option Explicit
Public Sub GetData()
'*** If Macro_Portal is not file containing this code: ***
Dim MacroPortalPath As String
MacroPortalPath = OpenFile ' or MacroPortalPath = "C:\...\...\Macro_PORTAL_APRR.xlsm"
Dim MacroPortal As Workbook
MacroPortal = Workbooks.Open(MacroPortalPath)
'*** If Macro Portal is the file containing this code: ***
'Dim MacroPortal As Workbook
'Set MacroPortal = ThisWorkbook
Dim pathKeys As String
pathKeys = OpenFile
If pathKeys <> "" Then
Dim wrkBk As Workbook
Set wrkBk = Workbooks.Open(pathKeys)
'Best to use sheet name rather than where it is in workbook (can be moved by user).
'You could replace MacroPortal with ThisWorkbook and remove first block of code in this procedure.
wrkBk.Worksheets("Sheet1").columns2.Copy Destination:=MacroPortal.Worksheets("Sheet1").Column(1)
wrkBk.Close SaveChanges:=False
End If
End Sub
Public Function OpenFile() As String
Dim dialogBox As FileDialog
Set dialogBox = Application.FileDialog(msoFileDialogFilePicker)
With dialogBox
.Title = "Keys File"
.AllowMultiSelect = False
.InitialFileName = "C:\"
If .Show = -1 Then
OpenFile = .SelectedItems(1)
End If
End With
End Function
I have a dialog box to pick a folder name and display the name of the folder that the user selects.
If the user selects cancel instead of folder path and OK, it throws an error.
I used a status variable and noticed that upon cancel the status changes to -1. So I tried to implement the code that is in comment section using a if condition to exit the sub.
That doesn't work in the case of selecting a folder when the commented part is present in the code.
Without that it works in selecting a folder.
sub abc()
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = "Select a folder then hit OK"
diaFolder.Show
'Status = diaFolder.Show
'If Status < 0 Then
'Exit Sub
'End If
a = diaFolder.SelectedItems(1)
MsgBox ("Folder selected is :" & a)
ens sub
Keep in mind that vbFalse = 0 and vbTrue = -1.
In other words clicking 'OK' would return -1 and clicking 'Cancel' would return 0.
Try the following code:
Sub abc()
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.Title = "Select a folder then hit OK"
If .Show = -1 Then
MsgBox ("Folder selected is :" & .SelectedItems(1))
Else
Exit Sub
End If
End With
End Sub
Sub abc()
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = "Select a folder then hit OK"
Dim status As Integer
status = diaFolder.Show
If status <> -1 Then
MsgBox "Cancel Chosen"
Exit Sub
End If
a = diaFolder.SelectedItems(1)
MsgBox ("Folder selected is :" & a)
End Sub
I know this is closed out but wanted to try posting for the first time. =D
If there are no items selected, *SelectedItems(1)*doesn't exist, and Excel will return an error. That's what's happening when the user presses the Cancel button.
A solution for this is to check how many items are selected using the structure below:
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
'Optional: limits the user to choosing a single option. Necessary if you want to avoid an error because the user selected multiple files.
.Title = "Dialog Title" 'Changing the title is also Optional
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Canceled by user" 'or just do nothing!
Else
MyVar = .SelectedItems(1)
End If
'Alternatively, "if .selecteditems.count = 1 then myvar = .selecteditems(1)" can be used
End With
new and would like to ask if someone could possibly check my code to see where i'm making a mistake.
first, i've created a form with two textboxes and two buttons that will go and get two different directories and the associated files. this is done through a call to a function that loads the dir to the textboxes.
a button to call a function to navigate dir and get the file
Private Sub CommandButton3_Click()
'call selectFile function to select file
selectFile
End Sub
function to get workbooks into textboxes 1 and 2:
Public Function selectFile()
Dim fileNamePath1 As String
Dim fileNamePath2 As String
Dim workbookFilePath1 As String
Dim workbookFilePath2 As String
On Error GoTo exit_
If workbookFilePath1 = Empty And workbookFilePath2 = Empty Then
fileNamePath1 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 1", MultiSelect:=False)
workbookFilePath1 = Dir(fileNamePath1)
'TextBox1.Text = workbookFilePath1
TextBox1.Value = fileNamePath1
fileNamePath2 = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Open Workbook 2", MultiSelect:=False)
workbookFilePath2 = Dir(fileNamePath2)
TextBox2.Value = fileNamePath2
If fileNamePath1 = False Or fileNamePath2 = False Then
MsgBox ("File selection was canceled.")
Exit Function
End If
End If
exit_:
End Function
up to here, the code is ok... can do better, but
here's where problems occur... i'd like to pass the directories as objects into the module to diff
button that executes module to diff:
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
i know that i've changed myPath1 and myPath2 to Workbooks, where I've had them as strings before
diffing module
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
Dim myExcelObj
Dim WorkbookObj1
Dim WorkbookObj2
Dim WorksheetObj1
Dim WorksheetObj2
Dim file1 As String
Dim file2 As String
Dim myWorksheetCounter As Integer
Dim i As Worksheet
Set myExcelObj = CreateObject("Excel.Application")
myExcelObj.Visible = True
Set file1 = Dir(myPath1)
Set file2 = Dir(myPath2)
Set WorkbookObj1 = myExcelObj.Workbooks.Open(file1)
Set WorkbookObj2 = myExcelObj.Workbooks.Open(file2)
Set NewWorkbook = myExcelObj.Workbooks.Add
While WorkbookObj1 <> Null And WorkbookObj2 <> Null
'While WorkbookObj1.ActiveWorkbook.Worksheets.count = WorkbookOjb2.ActiveWorkbook.Worksheets.count
myWorksheetCounter = ActiveWorkbook.Worksheets.count
myWorksheetCount = ActiveWorkbook.Worksheets.count
If WorksheetObj1.Worksheets.myWorksheetCounter = WorkbookObj2.Worksheets.myWorksheetCounter Then
Set WorksheetObj1 = WorkbookObj1.Worksheets(myWorksheetCounter)
Set WorksheetObj2 = WorkbookObj2.Worksheets(myWorksheetCounter)
Set myNewWorksheetObj = NewWorkbook.Worksheets(myWorksheetCounter)
For myWorksheetCounter = i To WorksheetObj1
For myWorksheetCount = j To WorksheetOjb2
'If cell.Value myWorksheetObj2.Range(cell.Address).Value Then
If cell.Value = myWorksheetObj2.Range(cell.address).Value Then
myNewWorksheetObj.Range(cell.address).Value = cell.address.Value
myNewWorksheetObj.Range(cell.address).Interior.ColorIndex = 3
Else
cell.Interior.ColorIndex = 0
End If
Next
'if doesn't work... use SaveChanges = True
myNewWorksheetObj.Workbooks.Save() = True
Next
Else
MsgBox ("The worksheets are not the same worksheets." & vbNewLine & "Please try again.")
End If
Wend
Set myExcelObj = Nothing
End Sub
So my question is... can someone please assist in seeing where i'm going wrong? essentially, i'm having some issues in trying to get this working.
much appreciated
i've gone through and cleaned up some areas a little bit... but now have a: "run time error '438': object doesn't support this propety or method" at the while loop code that i've updated the post with
I see a typo on CommandButton1_Click
Private Sub CommandButton1_Click()
getTheWorkbooksToCompare(fileNamePath1, fileNamePath2)
End Sub
Public Sub gettheWorkbooksToCompare(myPath1 As Workbook, myPath2 As Workbook)
There might be something more, but your not capitalizing the "T" in getThe, but you call it that way.
Sub test()
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir("thesentence") <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
In this when i pickup the text value from the input box, it doesn't work. If however, if remove "the sentence" from If Dir() and replace it with an actual name in the code, it works. Can somebody help?
Note your code contains Dir("thesentence") which should be Dir(thesentence).
Change your code to this
Sub test()
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir(thesentence) <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
Use the Office FileDialog object to have the user pick a file from the filesystem. Add a reference in your VB project or in the VBA editor to Microsoft Office Library and look in the help. This is much better than having people enter full paths.
Here is an example using msoFileDialogFilePicker to allow the user to choose multiple files. You could also use msoFileDialogOpen.
'Note: this is Excel VBA code
Public Sub LogReader()
Dim Pos As Long
Dim Dialog As Office.FileDialog
Set Dialog = Application.FileDialog(msoFileDialogFilePicker)
With Dialog
.AllowMultiSelect = True
.ButtonName = "C&onvert"
.Filters.Clear
.Filters.Add "Log Files", "*.log", 1
.Title = "Convert Logs to Excel Files"
.InitialFileName = "C:\InitialPath\"
.InitialView = msoFileDialogViewList
If .Show Then
For Pos = 1 To .SelectedItems.Count
LogRead .SelectedItems.Item(Pos) ' process each file
Next
End If
End With
End Sub
There are lots of options, so you'll need to see the full help files to understand all that is possible. You could start with Office 2007 FileDialog object (of course, you'll need to find the correct help for the version you're using).
Correction to fileExists from #UberNubIsTrue :
Function fileExists(s_directory As String, s_fileName As String) As Boolean
Dim obj_fso As Object, obj_dir As Object, obj_file As Object
Dim ret As Boolean
Set obj_fso = CreateObject("Scripting.FileSystemObject")
Set obj_dir = obj_fso.GetFolder(s_directory)
ret = False
For Each obj_file In obj_dir.Files
If obj_fso.fileExists(s_directory & "\" & s_fileName) = True Then
ret = True
Exit For
End If
Next
Set obj_fso = Nothing
Set obj_dir = Nothing
fileExists = ret
End Function
EDIT: shortened version
' Check if a file exists
Function fileExists(s_directory As String, s_fileName As String) As Boolean
Dim obj_fso As Object
Set obj_fso = CreateObject("Scripting.FileSystemObject")
fileExists = obj_fso.fileExists(s_directory & "\" & s_fileName)
End Function
just get rid of those speech marks
Sub test()
Dim thesentence As String
thesentence = InputBox("Type the filename with full extension", "Raw Data File")
Range("A1").Value = thesentence
If Dir(thesentence) <> "" Then
MsgBox "File exists."
Else
MsgBox "File doesn't exist."
End If
End Sub
This is the one I like:
Option Explicit
Enum IsFileOpenStatus
ExistsAndClosedOrReadOnly = 0
ExistsAndOpenSoBlocked = 1
NotExists = 2
End Enum
Function IsFileReadOnlyOpen(FileName As String) As IsFileOpenStatus
With New FileSystemObject
If Not .FileExists(FileName) Then
IsFileReadOnlyOpen = 2 ' NotExists = 2
Exit Function 'Or not - I don't know if you want to create the file or exit in that case.
End If
End With
Dim iFilenum As Long
Dim iErr As Long
On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0
Select Case iErr
Case 0: IsFileReadOnlyOpen = 0 'ExistsAndClosedOrReadOnly = 0
Case 70: IsFileReadOnlyOpen = 1 'ExistsAndOpenSoBlocked = 1
Case Else: IsFileReadOnlyOpen = 1 'Error iErr
End Select
End Function 'IsFileReadOnlyOpen
Function FileExists(fullFileName As String) As Boolean
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End Function
Works very well, almost, at my site. If I call it with "" the empty string, Dir returns "connection.odc"!! Would be great if you guys could share your result.
Anyway, I do like this:
Function FileExists(fullFileName As String) As Boolean
If fullFileName = "" Then
FileExists = False
Else
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End If
End Function
Function FileExists(fullFileName As String) As Boolean
FileExists = VBA.Len(VBA.Dir(fullFileName)) > 0
End Function
I'm not certain what's wrong with your code specifically, but I use this function I found online (URL in the comments) for checking if a file exists:
Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean
'Code from internet: http://vbadud.blogspot.com/2007/04/vba-function-to-check-file-existence.html
'Returns True if the passed sPathName exist
'Otherwise returns False
On Error Resume Next
If sPathName <> "" Then
If IsMissing(Directory) Or Directory = False Then
File_Exists = (Dir$(sPathName) <> "")
Else
File_Exists = (Dir$(sPathName, vbDirectory) <> "")
End If
End If
End Function
Very old post, but since it helped me after I made some modifications, I thought I'd share. If you're checking to see if a directory exists, you'll want to add the vbDirectory argument to the Dir function, otherwise you'll return 0 each time. (Edit: this was in response to Roy's answer, but I accidentally made it a regular answer.)
Private Function FileExists(fullFileName As String) As Boolean
FileExists = Len(Dir(fullFileName, vbDirectory)) > 0
End Function
based on other answers here I'd like to share my one-liners that should work for dirs and files:
Len(Dir(path)) > 0 or Or Len(Dir(path, vbDirectory)) > 0 'version 1 - ... <> "" should be more inefficient generally
(just Len(Dir(path)) did not work for directories (Excel 2010 / Win7))
CreateObject("Scripting.FileSystemObject").FileExists(path) 'version 2 - could be faster sometimes, but only works for files (tested on Excel 2010/Win7)
as PathExists(path) function:
Public Function PathExists(path As String) As Boolean
PathExists = Len(Dir(path)) > 0 Or Len(Dir(path, vbDirectory)) > 0
End Function