VBA PPT/Outlook: Date format changes from English to local

AMK · Feb 19th 2018

Dear All,

It would be great, if someone could help me with this problem I'm facing.

I wrote a VBA code to save a presentation as pdf and email it based on a document. However, I'm having problems with the date format in the Header of the email being changed from English to the local language when the email is sent out. The same problem I am facing with the date being posted in the message body. I am using Format to get the month written in English. Below is my code. Any help would be highly appreciated.

TIA!

-Anna

[VBA]
Sub ImportAndSafe()
Dim myFile As String
Dim textline As String
Dim actSclide As Slide
Dim actShape As Shape
Dim Filename As String
Dim PdfFile As String
Dim signature As String
Dim lastmonth As String

lastmonth = Format(DateAdd("m", -1, Now), "[$-409]mmmm yyyy")

Filename = ActivePresentation.Name
If InStr(Filename, ".") > 0 Then
Filename = Left(Filename, InStr(Filename, ".") - 1)
End If

myFile = ActivePresentation.Path & "\liste.txt"

Open myFile For Input As #1

Do Until EOF(1)
Line Input #1, textline

ActivePresentation.SaveAs ActivePresentation.Path & "\export\" & Filename & "_" & Replace(textline, " ", ""), ppSaveAsPDF

PdfFile = ActivePresentation.Path & "\export\" & Filename & "_" & Replace(textline, " ", "") & ".pdf"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
Set outlapp = GetObject(, "Outlook.Application")
If Err Then
Set outlapp = CreateObject("Outlook.Application")
IsCreated = True
End If
outlapp.Visible = True
On Error GoTo 0

With OutMail

.Display
signature = .HTMLBody
.Subject = "Report " & lastmonth & " for Company X"
.To = textline
.HTMLBody = " Dear " & textline & "," & " " _
& "attached please find the Report " & lastmonth & " for Company X." & " " _
& "If you have any questions or remarks, please do not hesitate to ask." & " " _
& "Best Regards," _
& signature
.Attachments.Add PdfFile

On Error Resume Next
.Send
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent " & textline, vbExclamation
End If
On Error GoTo 0
End With

Loop

Close #1

End Sub
[/VBA]

sysss · Feb 19th 2018

Hello Anna,

you could change your Regional settings to English (not always what you really want), or you might convert the returned string lastmonth using Select Case statement for example if the current regional settings is German:

Code

Sub datetest()
Dim lastmonth As String, currentYear As String
currentYear = Year(Now)
lastmonth = Format(DateAdd("m", -1, Now), "mmmm")
Select Case lastmonth
Case Is = "Januar"
lastmonth = "January"
Case Is = "Februar"
lastmonth = "February"
' etc
End Select
lastmonth = lastmonth & " " & currentYear
End Sub

Display More

s.

AMK · Feb 20th 2018

Hi S
and thank you for your suggestion.

What I decided to do is use a choose function:

[VBA]Dim lastmonth As String
Dim rep_year As String
lastmonth = Choose(Month(DateAdd("m", -1, Now)), "January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December")
If lastmonth = "December" Then
rep_year = Year(Now) - 1
Else
rep_year = Year(Now)
End If[/VBA]

I also noticed that I would experience a problem with the year. So, I also changed that.

Now it works well.

The easiest would have of course been to change the language settings of my Office programs, but as I am not the only one running the macro, it would be difficult.

BR, Anna

Share