Calling a Sub or Function

I created a macro that exports each page in the document to a specific folder with a specific name.

https://imgur.com/Rsxe23e

Folder path: D:\Sync\Tagify\Bud Light\Promotional\NFL\2023\Chargers\Fixed

File name: Chargers@Case Card - 11x17@Fixed@

I'm going back through my code to try and improve it. I'm trying to separate the steps into separate subs, or functions and calling them. However I'm having a hard time getting the values for the folder path and file name. Not sure if I'm doing this right.

Private Sub Export_Click()
    Dim sFileName As String, path As String
    Dim p As Page
    Dim expflt As ExportFilter

    'Set File Name
    Call Get_File_Name(sFileName)
    MsgBox "sFileName: " & sFileName 'returns nothing.
    
    'Set Path
    Call Get_File_Name
    MsgBox "path: " & path
    
    'Export All Pages
    For Each p In ActiveDocument.Pages
        p.Activate
        
        'Select objects on page
        ActiveLayer.Shapes.All.CreateSelection
        
        'If no objects selected, go to next page
        If ActiveSelectionRange.Count > 0 Then
    
            'Exports jpg
            Set expflt = ActiveDocument.ExportBitmap(path, cdrJPEG, cdrSelection, cdrRGBColorImage, 0, 0, 300, 300, cdrNormalAntiAliasing, False, True, True, False, cdrCompressionNone)
            With expflt
            .Smoothing = 50
            .Compression = 15
            .Finish
            End With
        End If
    Next p
    
    'Open folder of exported signs
    
    Call Shell("explorer.exe" & " " & path, vbNormalFocus)

End Sub

Function Get_File_Name(sFileName As String) As String

    Dim sFileName As String

    'Priced
    If Priced.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Priced" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Priced.Value = True And FrmMain.En_Y.Value <> "" Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Priced" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If

    'Fixed
    If Fixed.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Fixed" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Fixed.Value = True And FrmMain.En_Y.Value <> vbNull Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Fixed" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If

    'Template
    If Template.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Template" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Template.Value = True And FrmMain.En_Y.Value <> "" Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Template" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If

End Function

Top Replies

Taras.SoftLV 3 months ago +1

You have a line MsgBox "sFileName: " & sFileName 'returns nothing. because the name of the function =Get_File_Name= and you want to get data into the variable =sFileName= two options are possible here...

Parents

0 Taras.SoftLV 3 months ago

You have a line
MsgBox "sFileName: " & sFileName 'returns nothing.
because the name of the function =Get_File_Name= and you want to get data into the variable =sFileName=
two options are possible here

1. The name of the function must be the same
Function sFileName(text As String) As String
where one of the last lines should be:
sFileName = "blah - blah - blah"

Then MsgBox will give you
sFileName: blah - blah - blah

2. A variable must be specified In Option Explicit as
Dim sFileName As String
(instead of Dim can be Private or Public - depending on whether you want the variable to be available in a separate module or in the entire project)
in this case, any macro or function will be able to work with this variable.
Just make sure that =sFileName= is defined only once.

Regards
Taras
Cancel
Up +1 Down

Reply

Verify Answer

Cancel

0 Jamie Chestnut 3 months ago in reply to Taras.SoftLV

I got some help on the VBA subreddit. I was able to get the sFileName and path. But I'm running into an issue.

For the path, it's not getting the sFileName from the other Get_File_Name sub.

I'm getting this path with no filename set. just a ".jpg".
D:\Sync\Tagify\Bud Light\Promotional\NFL\2023\Chargers\Fixed\.jpg

(Also moved the calls into the for each loop.)

Private Sub Export_Click()
    Dim sFileName As String, path As String
    Dim p As Page
    Dim expflt As ExportFilter
    
    'Export All Pages
    For Each p In ActiveDocument.Pages
        p.Activate
        
        'Set File Name
        Call Get_File_Name(sFileName)
        MsgBox "sFileName: " & sFileName
        
        'Set Path
        Call Get_Path(path)
        MsgBox "path: " & path 'Isnt getting the sFileName
        
        'Select objects on page
        ActiveLayer.Shapes.All.CreateSelection
        
        'If no objects selected, go to next page
        If ActiveSelectionRange.Count > 0 Then
    
            'Exports jpg
            Set expflt = ActiveDocument.ExportBitmap(path, cdrJPEG, cdrSelection, cdrRGBColorImage, 0, 0, 300, 300, cdrNormalAntiAliasing, False, True, True, False, cdrCompressionNone)
            With expflt
            .Smoothing = 50
            .Compression = 15
            .Finish
            End With
        End If
    Next p
    
    'Open folder of exported signs
    
    Call Shell("explorer.exe" & " " & path, vbNormalFocus)

End Sub

Sub Get_File_Name(Optional sFileName As String) 'As String

    'Priced
    If Priced.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Priced" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Priced.Value = True And FrmMain.En_Y.Value <> "" Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Priced" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If

    'Fixed
    If Fixed.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Fixed" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Fixed.Value = True And FrmMain.En_Y.Value <> vbNull Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Fixed" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If

    'Template
    If Template.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Template" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Template.Value = True And FrmMain.En_Y.Value <> "" Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Template" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If

End Sub

Sub Get_Path(Optional path As String, Optional sFileName As String) 'As String

    Select Case True
        Case Priced
        path = SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\Priced\" & sFileName & ".jpg"

        Case Fixed
        path = SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\Fixed\" & sFileName & ".jpg"

        Case Template
        path = SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\Template\" & sFileName & ".jpg"
    End Select

End Sub

Reply

0 Jamie Chestnut 3 months ago in reply to Jamie Chestnut

I ended up combining Get_Path into Get_File_Name sub.

Private Sub Export_Click()
    Dim sFileName As String, path As String
    Dim p As Page
    Dim expflt As ExportFilter
    Dim FSO As New FileSystemObject
    Dim r As Integer, xTrue As Integer
    
    'Create Sign Title Folder
    If Not FSO.FolderExists(SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\") Then
           FSO.CreateFolder (SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\")
    End If
    
    'Create Priced,Fixed,Template folders
    Select Case True
        Case Priced
        If Not FSO.FolderExists(SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Priced") Then
               FSO.CreateFolder (SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Priced")
        End If

        Case Fixed
        If Not FSO.FolderExists(SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Fixed") Then
               FSO.CreateFolder (SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Fixed")
        End If

        Case Template
        If Not FSO.FolderExists(SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Template") Then
               FSO.CreateFolder (SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Template")
        End If
    End Select
    
    'Export current page only
    If CurrentPage.Value = True Then
        'Set File Name
        Call Get_File_Name(sFileName, path)
        
        'Select objects on page
        ActiveLayer.Shapes.All.CreateSelection
        
        'Exports jpg
        Set expflt = ActiveDocument.ExportBitmap(path, cdrJPEG, cdrSelection, cdrRGBColorImage, 0, 0, 300, 300, cdrNormalAntiAliasing, False, True, True, False, cdrCompressionNone)
        With expflt
        .Smoothing = 50
        .Compression = 15
        .Finish
        End With
        GoTo SkipToHere
    End If
    

    '-----------------------------------------------------------------------------------------------------
    
    'Export All Pages
    For Each p In ActiveDocument.Pages
        p.Activate
        
        'Set File Name
        Call Get_File_Name(sFileName, path)
        'MsgBox "sFileName: " & sFileName
        
        'Select objects on page
        ActiveLayer.Shapes.All.CreateSelection
        
        'If no objects selected, go to next page
        If ActiveSelectionRange.Count > 0 Then
    
            'Exports jpg
            Set expflt = ActiveDocument.ExportBitmap(path, cdrJPEG, cdrSelection, cdrRGBColorImage, 0, 0, 300, 300, cdrNormalAntiAliasing, False, True, True, False, cdrCompressionNone)
            With expflt
            .Smoothing = 50
            .Compression = 15
            .Finish
            End With
        End If
    Next p
    
    '-----------------------------------------------------------------------------------------------------
    
SkipToHere:
    
    'Open folder of exported signs
    Select Case True
        Case Priced
            Call Shell("explorer.exe" & " " & SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Priced", vbNormalFocus)
        Case Fixed
            Call Shell("explorer.exe" & " " & SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Fixed", vbNormalFocus)
        Case Template
            Call Shell("explorer.exe" & " " & SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\" & "Template", vbNormalFocus)
    End Select
    
    'Select 1st Page
    ActiveDocument.Pages(1).Activate

End Sub

Sub Get_File_Name(Optional sFileName As String, Optional path As String) 'As String

    'Set File name
    'Priced
    If Priced.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Priced" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Priced.Value = True And FrmMain.En_Y.Value <> "" Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Priced" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If

    'Fixed
    If Fixed.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Fixed" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Fixed.Value = True And FrmMain.En_Y.Value <> vbNull Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Fixed" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If

    'Template
    If Template.Value = True And FrmMain.En_Y.Value = "" Then 'No Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Template" & "@" & FrmMain.Tagify_Brand.Value
    
    ElseIf Template.Value = True And FrmMain.En_Y.Value <> "" Then 'With Expiration Date
        sFileName = FrmMain.Title.Value & "@" & ActivePage.Name & "@" & "Template" & "@" & Format(Now, "mm-dd-yyyy") & "@" & FrmMain.En_M.Value & "-" & FrmMain.En_D.Value & "-" & FrmMain.En_Y.Value & "@" & FrmMain.Tagify_Brand.Value
    End If
    
    'Set path
    Select Case True
        Case Priced
        path = SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\Priced\" & sFileName & ".jpg"

        Case Fixed
        path = SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\Fixed\" & sFileName & ".jpg"

        Case Template
        path = SignFolderTxt.Value & "\" & FrmMain.Title.Value & "\Template\" & sFileName & ".jpg"
    End Select

End Sub

Children

No Data