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

M

MistakesWereMade

Board Regular
Joined
May 22, 2019
Messages
103
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...

Code: 
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
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Sort by date Sort by votes
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
Code: 
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

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


​
​
​
 
Last edited:
Upvote 0
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:

Code: 
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
 
Upvote 0
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.

Code: 
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
 
Last edited:
Upvote 0
MistakesWereMade said:
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.
Click to expand...

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


From what I understood, you need something like this.:
Code: 
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 (/)
 
Upvote 0
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!

Code: 
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
 
Upvote 0
Hi,
untested but try these updates to both your codes & see if help you

Code: 
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
 
Last edited:
Upvote 0
Try this

Code: 
Function Mk_Dir(StrPath1 As String, NewFolder As String)
 
Upvote 0
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?
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
Merge all pdf files from a folder into single PDF using VBA
2
Replies
10
Views
2K
Dan_W
D
winstela
  • Solved
Sub or Function not defined
2
Replies
10
Views
871
Micron
M
H
  • Question
Macro to move csv files within-subfolder to folder "Old Templates"
Replies
2
Views
359
howard
H
H
  • Question
Macro to open up files in sub folder that have the lastest modified date as well as those 60 days before that date
Replies
1
Views
466
howard
H
H
  • Question
Macro: Convert pdf into Excel and extract certain data to put together with file name
Replies
1
Views
2K
HeinrichPaul
H

Forum statistics

Threads
1,214,641
Messages
6,120,685
Members
448,977
Latest member
dbonilla0331

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top