create folder at a point to be decided

[Marco1975]

hi,

I made this macro should create folder at a point to be decided, but not working .

Sub crea_dir()

Application.ScreenUpdating = False
Dim fpath As String, cartella As String


    GetFolderName = vbNullString
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Scegli destinazione cartella"
        .InitialFileName = initialfoldr$
        .Show
     
      'If .Show = False Then Exit Sub
     
       
    For lCount = 1 To .SelectedItems.Count
            fpath = .SelectedItems(lCount)
        Next lCount
      If fpath = "" Then
        Exit Sub
        End If
     
    End With
   
cartella = InputBox("Insert folder name")
If cartella = "" Then
Exit Sub
Else

Set Fs = CreateObject("Scripting.FileSystemObject")
If Not Fs.FolderExists("fpath, cartella") Then
Fs.CreateFolder ("fpath, cartella")
MsgBox "folder created", vbInformation
Else
MsgBox "folder already exists", vbInformation
Exit Sub

End If
End If
Application.ScreenUpdating = True


End Sub

Practically this macro should you choose initially the point where create the folder , then you should have to enter the name that you want to give , and if the folder does not exist create it .
you can help me?
Thank you.

 

[BBD]

Hi,

This should work.

Sub CreateFolder()
Dim fpath As String, FName As String

On Error GoTo MsgFolder:
Application.FileDialog(msoFileDialogFolderPicker).Show
fpath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)

FName = InputBox("Insert Folder Name")
If Not FName = "" Then
  If Len(Dir(fpath & "\" & FName, vbDirectory)) = 0 Then
  MkDir fpath & "\" & FName
  MsgBox "Folder Created"
  Else
  MsgBox "Folder already exists"
  End If
Else
MsgBox "Please enter folder name"
Exit Sub
End If

MsgFolder:
If Err.Number = 5 Then MsgBox "Please select a folder"

End Sub

Cheers,
BD

 

[Marc L]

Hi !

Just my point of view :
in the window FileDialog(msoFileDialogFolderPicker),
there is a icon to create a folder, what else ?! …
​

 

[Marco1975]

BBD perfect this works... thanks!!

 

[BBD]

Glad to help

Cheers,
BD