folder picker dialog box

[cocopops2001]

I have this peice of code that lets the user choose which folder they want to create a new workbook in. it is called by a button on a userform and seems to work well but for some reason it seems to call open itself when i click a button. basically for it to choose a folder, exit the form with X or click cancel i have to push the button twice. not sure why?

Function GetFolder(Optional startFolder As Variant = -1) As Variant
    Dim fldr As FileDialog
    Dim vItem As Variant
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        If startFolder = -1 Then
            .InitialFileName = ThisWorkbook.Path
        Else
            If Right(startFolder, 1) <> "\" Then
                .InitialFileName = startFolder & "\"
            Else
                .InitialFileName = startFolder
            End If
        End If
        If .show <> -1 Then GoTo NextCode
        vItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = vItem
    Set fldr = Nothing
End Function

 

[Richard Schollar]

Hi

I was having a bit of trouble understanding exactly what the problem is - is it that when you close the userform this code gets called? If so, what Userform events do you have enabled? eg QurtyClose etc

 

[cocopops2001]

run it and you will see what i mean, its meant to save the folder location so i can use it to create a file in, it works but only the second time i do it. if i choose a folder a click OK it brings up the folder picker again, same if i push cancel or X button. my userform code is here.

Option Explicit
 
Private Sub CommandButton1_Click()
    
    
    ''''OK button on userform
    Dim Myfile As String
        
    Myfile = ComboBox1.Value
    
    If Myfile = "" Then Exit Sub
    
    '''switches to already open workbook
    Workbooks(Myfile).Activate
        
    '''''checks if cover sheet exists and if not creates one
    covercheck
    
    ''''copies desired sheet
    ThisWorkbook.ActiveSheet.Range("a11:n70").Copy
    
    '''''copies desired sheet
    sheetcopy
     
    UserForm3.Hide
    
End Sub
Private Sub CommandButton2_Click()
''''''create new file button
''''''gets folder location
GetFolder

UserForm3.Hide

MsgBox GetFolder
    
End Sub
    
Private Sub CommandButton3_Click()
    ''''''cancel button
    CloseMode = vbFormControlMenu

End Sub

Private Sub CommandButton4_Click()

''''''brose for file button
''''''opens file browser
    OpenCalc
       
    UserForm3.Hide

End Sub

'''start up of form, loads open books in drop down list

Private Sub UserForm_Initialize()
    Dim wkb As Workbook
    Me.Label4.Caption = "List of Open Workbooks..."
    With Me.ComboBox1
        For Each wkb In Application.Workbooks
            If wkb.name = ThisWorkbook.name Then
            Else
            .AddItem wkb.name
            End If
        Next wkb
    End With
End Sub

EDIT: i know that the code for my cancel button does not work in this example, i was having problems with the form not checking for open files if it was called after the cancel button was pushed

 

[Richard Schollar]

You need to assign the return of the GetFOlder function to a variable - your message box is simply calling the function again (which is why you see it twice):

Private Sub CommandButton2_Click()
''''''create new file button
''''''gets folder location

Dim strMyFolder As String

strMyFolder =  GetFolder


UserForm3.Hide

MsgBox strMyFolder
    
End Sub

Note that the above isn't doing anything with the folder name (other than displaying it with a MsgBox). Presumably you will be doing something with it?

 

[cocopops2001]

worked perfect. thanks

yes the msgbox was just to test that it was returning the folder path in full. will be using to create a new book in the specified directory.