How Do I Change The Date Format in VBA Code

[nathandavies]

Hi All, I have some Code which works apart from when I want to name a file with the date (IE Advice Note - 20/04/2018.pdf) it keeps crashing. i know the reason why because your not allowed to use "/" in the name of a file but how do you change it in the coding to show like the following Advice Note_20-04-2018.pdf
I have put my code below for your viewing so you can see how i've created the code.

Thanks in Advance

Sub PrintAdviceNote()

ProjectRootFolder = Sheets("RootFolder").Range("B5").Value
JobNumber = Sheets("Summary").Range("CJobNumber").Value
CSiteName = Sheets("Summary").Range("CSiteName").Value
CCompanyName = Sheets("Summary").Range("CCompanyName").Value
AdviceNote = Sheets("AdviceNote").Range("DelNote").Value


    
    
    Sheets("AdviceNote").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    With Sheets("AdviceNote")
        .Visible = True
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             FileName:=ProjectRootFolder & Application.PathSeparator & _
                                       CCompanyName & Application.PathSeparator & _
                                       JobNumber & " " & CSiteName & Application.PathSeparator & _
                                       AdviceNote & "_" & Date & ".pdf", _
                                       Quality:=xlQualityStandard, _
                                       IncludeDocProperties:=True, _
                                       IgnorePrintAreas:=False, _
                                       OpenAfterPublish:=True
                                        .Visible = True
    End With
    Sheets("Summary").Select
    ActiveWorkbook.Save
End Sub

[Paul_Hossler]

This is function from my utility belt that 'cleans' file and folder names by replacing illegal characters with an underscore

There are some other characters besides \ that are not allowed, so I thought I'd make it as robust as possible

I also decided that I wanted spaces replaced with underscores also, but that's changeable

It doesn't run very often so performance isn't an issue so I tried to make it as straight forward as possible

Function fileCleanName(s As String, Optional ThisIsAFolder As Boolean = False) As String
    Dim s1 As String, s2 As String
    Dim i As Long
    
    
    s1 = vbNullString
    s2 = Trim(s)
    
    If Not ThisIsAFolder Then
        For i = 1 To Len(s2)
            Select Case Mid(s2, i, 1)
                Case Chr(0) To Chr(32), "<", ">", ":", """", "/", "\", "|", "?", "*"
                    s1 = s1 & "_"
                Case Else
                    s1 = s1 & Mid(s2, i, 1)
            End Select
        Next i
    
    'paths can have / and \
    Else
        For i = 1 To Len(s2)
            Select Case Mid(s2, i, 1)
                Case Chr(0) To Chr(32), "<", ">", ":", """",  "|", "?", "*"
                    s1 = s1 & "_"
                Case Else
                    s1 = s1 & Mid(s2, i, 1)
            End Select
        Next i
    End If
    
    Do While InStr(s1, "__") > 0
        s1 = Replace(s1, "__", "_")
    Loop
    
    fileCleanName = s1
End Function

[nathandavies]

Thanks Paul,

When would i call this function in to action??

Nathan

[Paul_Hossler]

Thanks Paul,

When would i call this function in to action??

Nathan

Just like any other function

Sub PrintAdviceNote()
ProjectRootFolder = Sheets("RootFolder").Range("B5").Value
JobNumber = Sheets("Summary").Range("CJobNumber").Value
CSiteName = Sheets("Summary").Range("CSiteName").Value
CCompanyName = Sheets("Summary").Range("CCompanyName").Value
AdviceNote = Sheets("AdviceNote").Range("DelNote").Value

filenametosave = ProjectRootFolder & Application.PathSeparator
filenametosave = filenametosave & CCompanyName & Application.PathSeparator
filenametosave = filenametosave & JobNumber & " " & CSiteName & Application.PathSeparator
filenametosave = filenametosave & AdviceNote & "_" & Format(Date, "dd-mm-yyyy") & ".pdf"
    
MsgBox filenametosave


filenametosave = cleanfilename(filenametosave)
MsgBox filenametosave
    
    
    Sheets("AdviceNote").Select
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
    
    With Sheets("AdviceNote")
        .Visible = True
        .ExportAsFixedFormat Type:=xlTypePDF, _
                             Filename:=filenametosave, _
                                       Quality:=xlQualityStandard, _
                                       IncludeDocProperties:=True, _
                                       IgnorePrintAreas:=False, _
                                       OpenAfterPublish:=True
                                        .Visible = True
    End With
    Sheets("Summary").Select
    ActiveWorkbook.Save
End Sub
 
Function fileCleanName(s As String, Optional ThisIsAFolder As Boolean = False) As String
    Dim s1 As String, s2 As String
    Dim i As Long
    
    
    s1 = vbNullString
    s2 = Trim(s)
    
    If Not ThisIsAFolder Then
        For i = 1 To Len(s2)
            Select Case Mid(s2, i, 1)
                Case Chr(0) To Chr(32), "<", ">", ":", """", "/", "\", "|", "?", "*"
                    s1 = s1 & "_"
                Case Else
                    s1 = s1 & Mid(s2, i, 1)
            End Select
        Next i
    
    'paths can have / and \
    Else
        For i = 1 To Len(s2)
            Select Case Mid(s2, i, 1)
                Case Chr(0) To Chr(32), "<", ">", ":", """", "|", "?", "*"
                    s1 = s1 & "_"
                Case Else
                    s1 = s1 & Mid(s2, i, 1)
            End Select
        Next i
    End If
    
    Do While InStr(s1, "__") > 0
        s1 = Replace(s1, "__", "_")
    Loop
    
    fileCleanName = s1
End Function

[nathandavies]

Hi Paul,
i have tried the code and i keep getting an compile error. "Sub or Fuction not Defined"

filenametosave = cleanfilename(filenametosave)

[Bob Phillips]

Should it be

filenametosave = fileCleanName(filenametosave)

[nathandavies]

Thanks xld, I didn’t notice that, I now have the following error "ByRef argument type mismatch"

(filenametosave)

[Bob Phillips]

You need to declare filenametosave as a string variable, as it is undeclared it is being treated as a variant.

[nathandavies]

Thanks for your help, this has worked but is now not saving the PDF in the correct location, i think its because its removing all the "" & "/" from the patch and not the file name only.

[nathandavies]

Ive managed to fix the problem.

Thank you for your help!

[Paul_Hossler]

Hi Paul,
i have tried the code and i keep getting an compile error. "Sub or Fuction not Defined"

filenametosave = cleanfilename(filenametosave)

My fault -- Careless mistake

I always use Option Explicit for my stuff, but followed your lead and didn't use it since no variables were Dim-ed

Since I couldn't test it, the macro never got a chance to fail

[nathandavies]

Paul, not a problem thank you for you help on this!