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

 

[dmt32]

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?

[FONT=&quot]you need a reference to Microsoft Scripting Runtime

[/FONT] - In the VBA IDE, go to Tools > References
- Tick "Microsoft Scripting Runtime" and click OK

Dave

 

[DanteAmor]

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[B][COLOR=#ff0000]\kk\mm\[/COLOR][/B]"
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, [B][COLOR=#ff0000]thisMonday As Date, thisSunday As Date[/COLOR][/B])
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

The code delivered in post #5 works fine.
But you are continually changing variables and directories.
Try the macro of post # 5 and since you master the operation well then you make changes.

 

[MistakesWereMade]

I've tried the suggestions but I still run into errors. Is there another way instead of using FileSystemObject? It seems to be the root of the cause.

 

[dmt32]

I've tried the suggestions but I still run into errors. Is there another way instead of using FileSystemObject? It seems to be the root of the
cause.

assuming you have selected scripting runtime in the references as mentioned, what is the error you are getting?

Dave

 

[DanteAmor]

I've tried the suggestions but I still run into errors. Is there another way instead of using FileSystemObject? It seems to be the root of the cause.

You put this in Post #1 . That's why I thought that worked for you.

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...

Either way. That simplifies some things.

Your initial folder is this:
Pth3 = Environ("Userprofile") & "\Desktop\Folder"

The new folder will be like this:
29-07-2019 Thru 04-08-2019

Final folder:
Environ("Userprofile") & "\Desktop\Folder\29-07-2019 Thru 04-08-2019"

Final File:
Environ("Userprofile") & "\Desktop\Folder\29-07-2019 Thru 04-08-2019\textbox1.xlsx"

Just the above is done by the following macro. Please, do not modify it until it works for you.
Note: the Mk_Dir function is no longer necessary

Private Sub CommandButton1_Click()
  Dim Pth3 As String, OpeningVar3 As String, Wbk3 As Workbook
  Dim thisMonday As String, thisSunday As String, NewFolder 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, "dd-mm-yyyy")
    thisSunday = Format(Date + 7 - Weekday(Date, vbMonday), "dd-mm-yyyy")
    NewFolder = thisMonday & " Thru " & thisSunday
[COLOR=#0000ff]    If Dir(Pth3 & NewFolder, vbDirectory) = "" Then[/COLOR]
[COLOR=#0000ff]      MkDir Pth3 & NewFolder[/COLOR]
[COLOR=#0000ff]    End If[/COLOR]
    ActiveWorkbook.SaveCopyAs Pth3 & NewFolder & "\" & UserForm4.TextBox1.Value & " " & Format(Date, "mm_dd_yy") & ".xlsx"
    MsgBox "File salved"
End Sub

Let me know any problem.

 

[MistakesWereMade]

Excel GOD...Honestly....

Thank you so much Mr. DanteAmor. This works much better than the function and it's flawless!
Thanks for your help too dmt32. Really appreciate both of your guys' help.

 

[DanteAmor]

Excel GOD...Honestly....

Thank you so much Mr. DanteAmor. This works much better than the function and it's flawless!
Thanks for your help too dmt32. Really appreciate both of your guys' help.

I'm glad to help you. Thanks for the feedback.