Excel ignores my programming statement that it should exit the sub if the item count is nothing
Given that it ignored the first IF statement, I tried to simply catch it with a second one, but it ignores that as well!
The code not only executes, but it just skips over all statements, and if I try to go through it line by line using F8, then it executes the full code.
I don't understand why it does this or what could cause it... Any help is appreciated.
Private Sub SelectFolder()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & " \"
.Title = "Select Folder"
.Show
If .SelectedItems.Count = 0 Then
Exit Sub
Else
sPfad = .SelectedItems(1)
End If
End With
If sPfad = "" Then Exit Sub
End Sub
UPDATE:
After getting this response which worked well when I tried it stepping through the code automatically, I realized that when I ran the whole procedure, my problem persisted.
Today I finally learned what is happening... the sub does in fact, as programmed, stop and end. THAT particular sub. However, since I'm calling it from a different sub in a procedure, the code then goes back to the calling sub and continues.
What I needed was simply to change Exit Sub to End since I needed the whole procedure to stop!
Try this one:
Sub SelectFolder()
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & " \"
.Title = "Select Folder"
If Not .Show Then Exit Sub
sPfad = .SelectedItems(1)
End With
End Sub
when user press "Cancel" - .Show returns 0 (False). But if user press "OK" - current folder in FileDialog window is selected
A different approach:
Private Sub SelectFolder()
Dim strPath As Variant
Dim sPfad As Variant
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & " \"
.Title = "Select Folder"
End With
strPath = Application.FileDialog(msoFileDialogFolderPicker).Show
If strPath = False Then
Exit Sub
Else
sPfad = strPath
End If
End Sub
Related
VBA to open a dialogue box by clicking buttons, select files individually, place the path in more than one text boxes, click another button to import the files
I have been searching on the web but all the codes have both selecting and importing in one program
'Module
Public Sub ImportDocument()
On Error GoTo ErrProc
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Some Title"
With .Filters
.Clear
.Add "TXT documents", "*.txt", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False
If .Show = 0 Then GoTo Leave
End With
Dim selectedItem As Variant
For Each selectedItem In fd.SelectedItems
DoCmd.TransferText acImportDelim, "team_Specs", "team", selectedItem, True, ""
'DoCmd.TransferText acImportDelim, "Raw Data from Import_ Import Specification", "Raw Data from Import", selectedItem, True, ""
Next
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox err.Description, vbCritical
Resume Leave
End Sub
'Form
Private Sub Command2_Click()
Dim status_ As TaskImportEnum
status_ = ImportDocument
Select Case status_
Case TaskImportEnum.Success:
MsgBox "Success!"
Case TaskImportEnum.Failure:
MsgBox "Failure..."
Case Else:
MsgBox "Aborted..."
End Select
End Sub
You need to break down the import sub into multiple tasks.
The Select file Function returns only the file path of the selected document and the path is then inserted into the relevant TextBox.
The import button then validates the TextBox has a value and yes, it imports it.
1. Select file.
Private Sub ButtonSelect_Click()
Dim file_ As String
file_ = SelectDocument()
'Selection was made?
If file_ <> vbNullString Then TextBoxFilePath.Value = file_
End Sub
The Function to select a file.
Public Function SelectDocument() As String
On Error GoTo Trap
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Some Title"
With .Filters
.Clear
.Add "TXT documents", "*.txt", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False
End With
'if a selection was made, return the file path
If fd.Show = -1 Then SelectDocument = fd.SelectedItems(1)
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Function
Trap:
MsgBox Err.Description, vbCritical
Resume Leave
End Function
2. Import if a selection has been made.
Private Sub ButtonImport_Click()
With TextBoxFilePath
If Not IsNull(.Value) Then
DoCmd.TransferText acImportDelim, "team_Specs", "team", .Value, True, ""
End If
End With
End Sub
You need to change the names of the Buttons and TextBoxes.
Quick question, I have a simple bit of code which allows the user to click on a textbox and find the location of the required file. However, can I get this so that when the "Browser" popup appears, is so that it shows a specific file path ie; T:\Production
Private Sub SideProfile_Click()
Dim vrtSelectedItem As Variant
With Application.FileDialog(3)
.AllowMultiSelect = False
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
SideProfile = "#" & vrtSelectedItem & "#"
Next vrtSelectedItem
Else
End If
End With
End Sub
Add
.InitialFileName = CurrentProject.Path 'Or any path
to the With Application.FileDialog(3) block.
I have some trouble with my code. I'll be glad if you can help me to where i am wrong.
This is my sheet's (name is SetSheet) code section; cmdSelProjectDir_Click() is my ActiveX command button which i try to select my working directory. SetSheet.txtSetWorkDir is my ActiveX textbox, selected directory path written into this. GetFolder(txtDir) is my procedure i call it from "Settings" module.
But i didn't built in proper way it gaves an error like that "Type Mismatch". But i don't know how is it possible to apply this type of strcture to code because i will be use this GetFolder subprocedure also on my other sheets.
'/SetSheet Page
Sub cmdSelProjectDir_Click()
Dim txtDir As TextBox
Set txtDir = SetSheet.txtSetWorkDir
Call Settings.GetFolder(txtDir)
End Sub
And here my procedure;
'/GetFolder procedure from Settings module.
Sub GetFolder(txtDir As TextBox)
Dim fdo As FileDialog
Dim sDir As String
Set fdo = Application.FileDialog(msoFileDialogFolderPicker)
With fdo
.Title = "Select a Directory"
.AllowMultiSelect = False
.InitialFileName = Application.DefaultFilePath
If .Show <> -1 Then GoTo NextCode
sDir = .SelectedItems(1)
txtDir.Value = sDir
Debug.Print txtDir.Value; sDir
End With
NextCode:
' GetFolder = sDir
Set fdo = Nothing
End Sub
You have to use MSForms.TextBox instead of TextBox for an ActiveX text box:
Dim txtDir As MSForms.TextBox
and
Sub GetFolder(txtDir As MSForms.TextBox)
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)
Basically I have a spreadsheet with a form on it. On that form there is a textbox that contains a file path which could be pre-populated from a cell on the sheet. But the user can choose to browse for another file. When they are browsing they have an option of "Open" or "Cancel". The open button works fine and populates the textbox, but if they choose cancel it clears the textbox if it is already populated. How can I stop the textbox being cleared?
I have narrowed it down to this block of code where it is happening:
Function GetFileName()
Set MyFile = Application.FileDialog(msoFileDialogOpen)
With MyFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Function
End If
GetFileName = .SelectedItems(1)
End With
End Function
This done the trick. Making sure the file name has a value before populating the textbox
Private Sub btnBrowse_Click()
Dim sFileName As String
sFileName = GetFileName()
If Len(sFileName) > 0 Then
TextBox1.Value = sFileName
End If
End Sub
Function GetFileName()
Set MyFile = Application.FileDialog(msoFileDialogOpen)
With MyFile
.Title = "Choose File"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Function
End If
GetFileName = .SelectedItems(1)
End With
End Function