Is there a way to trigger a sub from inside another sub?

[MistakesWereMade]

I have a commandbutton_click sub that I would like to code so that a folder is created. Is there a way to call on a function/sub and to have it run its code and then go back to the commandbutton_click sub to finish?

The function is below...

Function MkDir(strDir As String, strPath As String)


Dim fso As New FileSystemObject
Dim path1 As String


'examples for what are the input arguments
strDir = thisMonday & " Thru " & thisSunday 
strPath = Environ("Userprofile") & "\Desktop\bn9\"


path1 = strPath & strDir


If Not fso.FolderExists(path1) Then


' doesn't exist, so create the folder
          fso.CreateFolder path1


End If


End Function

 

[Kamolga]

To use a function, you just need to put the name and the elements (in this case

strDir as text and

strPath as text), so

Sub btnclick

[LEFT][COLOR=#333333][FONT=monospace]MkDir("Directory you want","Path you want") 
End sub[/FONT][/COLOR][/LEFT]

If it was a sub and not a function, you would use

Sub btnclick
[LEFT][COLOR=#333333][FONT=monospace]
Call MkDir[/FONT][/COLOR]
[COLOR=#333333][FONT=monospace]End sub[/FONT][/COLOR][/LEFT]

​

​

​

 

[DanteAmor]

First, MkDir() is a function that already exists in VBA, you should use another name, for example Mk_Dir()


The arguments for the function, at least for me, should go in this order, directory and new folder:

Try this:

Private Sub CommandButton1_Click()
  Dim wPath As String, wNewFolder As String
  wPath = [COLOR=#ff0000]"C:\trabajo\books\" [/COLOR]         'Directory Name
  wNewFolder =[COLOR=#ff0000] "NameFolder"[/COLOR]           'Name of the new folder
  If Mk_Dir(wPath, wNewFolder) = True Then
    '
    'Here you could continue another code.
    '
  Else
    MsgBox "The folder exists"
  End If
End Sub


Function Mk_Dir([COLOR=#0000ff]strPath [/COLOR]As String, [COLOR=#0000ff]wNewFolder [/COLOR]As String)
  Dim fso As New FileSystemObject
  Dim path1 As String
  
  path1 = strPath & wNewFolder
  
  If Not fso.FolderExists(path1) Then
  ' doesn't exist, so create the folder
    fso.CreateFolder path1
    Mk_Dir = True
  Else
    Mk_Dir = False
  End If
End Function

 

[MistakesWereMade]

Thanks both you guys! I really appreciate the detail DanteAmor. I am still having issues running my code though. I run into an error that says "ByRef type mismatch" when I try to call on my function with the if statement. Any ideas? My full code is below.

Private Sub CommandButton1_Click()
    
    Pth3 = Environ("Userprofile") & "\Desktop\Folder\"


    OpeningVar3 = "Template.xlsx"
    
    Set Wbk3 = Workbooks.Open(Pth3 & OpeningVar3)


    If Application.CommandBars("Ribbon").Height <= 150 Then
        CommandBars.ExecuteMso "HideRibbon"
    End If


    With Wbk3
    
        Wbk3.ActiveSheet.Label1.Caption = UserForm4.TextBox1.Value
        Wbk3.ActiveSheet.Label2.Caption = Date
        
    End With


    If Mk_Dir(StrPath1, NewFolder) = True Then
    
        ActiveWorkbook.SaveCopyAs Environ("Userprofile") & "\Desktop\Folder\" & NewFolder & "\" & UserForm4.TextBox1.Value & " " & Format(Date, "mm_dd_yy") & ".xlsx"
    
    Else
    
       ActiveWorkbook.SaveCopyAs Environ("Userprofile") & "\Desktop\Folder\" & NewFolder & "\" & UserForm4.TextBox1.Value & " " & Format(Date, "mm_dd_yy") & ".xlsx"
    
    End If
    
End Sub

Function Mk_Dir(StrPath1 As String, NewFolder As String)


Dim thisMonday As Date
Dim thisSunday As Date
Dim StrPath1 As String
Dim NewFolder As String
Dim fso As New FileSystemObject
Dim path1 As String


thisMonday = Date - Weekday(Date, vbMonday) + 1
thisSunday = Date + 7 - Weekday(Date, vbMonday)


'examples for what are the input arguments
NewFolder = thisMonday & " Thru " & thisSunday
StrPath1 = Environ("Userprofile") & "\Desktop\Folder\"


path1 = StrPath1 & NewFolder


If Not fso.FolderExists(path1) Then


' doesn't exist, so create the folder
    fso.CreateFolder path1
    Mk_Dir = True


Else


    Mk_Dir = False


End If


End Function

 

[DanteAmor]

Thanks both you guys! I really appreciate the detail DanteAmor. I am still having issues running my code though. I run into an error that says "ByRef type mismatch" when I try to call on my function with the if statement. Any ideas? My full code is below.

Your code had several problems, I had to redo several parts.


From what I understood, you need something like this.:

Private Sub CommandButton1_Click()
  Dim [COLOR=#0000ff]Pth3 [/COLOR]As String, OpeningVar3 As String, Wbk3 As Workbook
  Dim thisMonday As String, thisSunday As String, NewFolder As String
    
[COLOR=#0000ff]    Pth3 = Environ("Userprofile") & "\Desktop\Folder\"[/COLOR]
    OpeningVar3 = "Template.xlsx"
    Set Wbk3 = Workbooks.Open(Pth3 & OpeningVar3)
    If Application.CommandBars("Ribbon").Height <= 150 Then
        CommandBars.ExecuteMso "HideRibbon"
    End If
    With Wbk3
        Wbk3.ActiveSheet.Label1.Caption = UserForm4.TextBox1.Value
        Wbk3.ActiveSheet.Label2.Caption = Date
    End With
    thisMonday = Format(Date - Weekday(Date, vbMonday) + 1, "dd_mm_yyyy")
    thisSunday = Format(Date + 7 - Weekday(Date, vbMonday), "dd_mm_yyyy")
    NewFolder = thisMonday & " Thru " & thisSunday
    res = Mk_Dir(Pth3, NewFolder)
    If res = "" Then
        ActiveWorkbook.SaveCopyAs Pth3 & NewFolder & "\" & UserForm4.TextBox1.Value & " " & Format(Date, "mm_dd_yy") & ".xlsx"
    Else
        MsgBox res
    End If
End Sub


Function Mk_Dir(StrPath1 As String, NewFolder As String)
  Dim path1 As String, fso As New FileSystemObject
  path1 = StrPath1 & NewFolder
  If Not fso.FolderExists(path1) Then
    On Error Resume Next
        fso.CreateFolder path1
    If Err.Number = 0 Then
      Mk_Dir = ""
    Else
      Mk_Dir = "Error: " & Err.Number & " Description: " & Err.Description
    End If
  End If
End Function

I changed the date format to dd_mm_yyyy to create the folder, you cannot create a file with the slash (/)

 

[MistakesWereMade]

Thanks for the edits. I still get an error though right at "res = Mk_Dir". It says Argument not optional. Below is my code with your edits and a few more. Thanks for all your help!

Private Sub CommandButton1_Click()


Dim Wbk3 As Workbook
Dim Pth3 As String
Dim OpeningVar3 As String


Dim StrPath1 As String
Dim NewFolder As String
Dim thisMonday As String
Dim thisSunday As String


    Pth3 = Environ("Userprofile") & "\Desktop\Folder\"


    OpeningVar3 = "Template.xlsx"
    
    Set Wbk3 = Workbooks.Open(Pth3 & OpeningVar3)


    If Application.CommandBars("Ribbon").Height <= 150 Then
        CommandBars.ExecuteMso "HideRibbon"
    End If


    With Wbk3
    
        Wbk3.ActiveSheet.Label1.Caption = UserForm4.TextBox1.Value
        Wbk3.ActiveSheet.Label2.Caption = Date
        
    End With


thisMonday = Format(Date - Weekday(Date, vbMonday) + 1, "mm_dd_yy")
thisSunday = Format(Date + 7 - Weekday(Date, vbMonday), "mm_dd_yy")


NewFolder = thisMonday & " Thru " & thisSunday
StrPath1 = Environ("Userprofile") & "\Desktop\Folder\kk\mm\"


res = Mk_Dir(StrPath1, NewFolder)


If res = "" Then
    
    ActiveWorkbook.SaveCopyAs Environ("Userprofile") & "\Desktop\Folder\kk\mm\" & NewFolder & "\" & UserForm4.TextBox1.Value & " " & Format(Date, "mm_dd_yy") & ".xlsx"
    
Else
    
    ActiveWorkbook.SaveCopyAs Environ("Userprofile") & "\Desktop\Folder\kk\mm\" & NewFolder & "\" & UserForm4.TextBox1.Value & " " & Format(Date, "mm_dd_yy") & ".xlsx"
    
End If
    
End Sub




Function Mk_Dir(StrPath1 As String, NewFolder As String, thisMonday As Date, thisSunday As Date)


Dim fso As New FileSystemObject
Dim path1 As String


path1 = StrPath1 & NewFolder


If Not fso.FolderExists(path1) Then


    On Error Resume Next
    ' doesn't exist, so create the folder
    fso.CreateFolder path1
    
    If Err.Number = 0 Then
        Mk_Dir = ""
    Else
        Mk_Dir = "Error: " & Err.Number & " Description: " & Err.Description
    End If
End If


End Function

 

[dmt32]

Hi,
untested but try these updates to both your codes & see if help you

Private Sub CommandButton1_Click()
  Dim Pth3 As String, OpeningVar3 As String
  Dim thisMonday As String, thisSunday As String, NewFolder As String
  Dim Wbk3 As Workbook
    
    On Error GoTo myerror
    Pth3 = Environ("Userprofile") & "\Desktop\Folder\"
    
    OpeningVar3 = "Template.xlsx"
    
    thisMonday = Format(Date - Weekday(Date, vbMonday) + 1, "dd_mm_yyyy")
    thisSunday = Format(Date + 7 - Weekday(Date, vbMonday), "dd_mm_yyyy")
    NewFolder = thisMonday & " Thru " & thisSunday
    
    Application.ScreenUpdating = False
    Set Wbk3 = Workbooks.Open(Pth3 & OpeningVar3, False, True)
    If Application.CommandBars("Ribbon").Height <= 150 Then CommandBars.ExecuteMso "HideRibbon"
    
    With Wbk3.Sheets(1)
        .Label1.Caption = Me.TextBox1.Value
        .Label2.Caption = Date
    End With
            
    If Mk_Dir(Pth3, NewFolder) Then Wbk3.SaveCopyAs Pth3 & NewFolder & "\" & _
                                                    Me.TextBox1.Value & _
                                                    " " & Format(Date, "mm_dd_yy")
myerror:
    If Not Wbk3 Is Nothing Then Wbk3.Close False
    Application.ScreenUpdating = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub




Function Mk_Dir(ByVal StrPath1 As String, ByVal NewFolder As String) As Boolean
  Dim path1 As String, fso As New FileSystemObject
  path1 = StrPath1 & NewFolder
  If Not fso.FolderExists(path1) Then fso.CreateFolder path1
  Mk_Dir = True
End Function

I have assumed Userform4 is the active form & replaced name with Me keyword

Dave

 

[DanteAmor]

Try this

Function Mk_Dir(StrPath1 As String, NewFolder As String)

 

[MistakesWereMade]

Thanks Dave! It seems to be working a little more fluidly, but it still gets caught up on the function portion. It highlights when I declare my fso variable as "New FileSystemObject" and errors with "Compile Error: User-defined type not defined". Any ideas on this?

 

[MistakesWereMade]

Thanks for catching that. Yeah, it progressed through the code a little more but it receives the same error as with Dave's code unfortunately.