Save emails to pdf without notification - vba

Question

I have found this code to download emails and convert them to PDF. It works perfectly but the only question that I have is it possible to remove the save notification and that it saves it automaticly when you trigger the macro?
Below is whole my code:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
Set MyOlNamespace = Application.GetNamespace("MAPI")
Set MySelectedItem = ActiveExplorer.Selection.Item(1)
Set fso = CreateObject("Scripting.FileSystemObject")
'tmpFileName = FSO.GetSpecialFolder(2)
tmpFileName = "C:\CRM\Postboek\Ongekoppeld"
strRecieved = MySelectedItem.ReceivedByName
strSender = MySelectedItem.SenderName
strDatum = MySelectedItem.ReceivedTime
strDatum = Replace(strDatum, ":", "-")
strDatum = Replace(strDatum, "/", "-")
strName = "email_temp.mht"
tmpFileName = tmpFileName & "\" & strName
MySelectedItem.SaveAs tmpFileName, 10
On Error Resume Next
' If MySelectedItem.BodyFormat <> olFormatHTML Then
' strDeletedFiles = strDeletedFiles & vbCrLf & "<file://" & strFile & ">"
' Else
' strDeletedFiles = strDeletedFiles & "<br>" & "<a href='file://" & _
'' strFile & "'>" & strFile & "</a>"
' End If
' If MySelectedItem.BodyFormat <> olFormatHTML Then
' MySelectedItem.Body = vbCrLf & "The file(s) were saved to " & strDeletedFiles & vbCrLf & MySelectedItem.Body
' Else
' MySelectedItem.HTMLBody = "<p>" & "The file(s) were saved to " & strDeletedFiles & "</p>" & MySelectedItem.HTMLBody
' End If
Set wrdApp = GetObject(, "Word.Application")
If Err Then
Set wrdApp = CreateObject("Word.Application")
bStarted = True
End If
On Error GoTo 0
Set wrdDoc = wrdApp.Documents.Open(FileName:=tmpFileName, Visible:=False, Format:=7)
Set dlgSaveAs = wrdApp.FileDialog(msoFileDialogSaveAs)
Set fdfs = dlgSaveAs.Filters
i = 0
For Each fdf In fdfs
i = i + 1
If InStr(1, fdf.Extensions, "pdf", vbTextCompare) > 0 Then
Exit For
End If
Next fdf
dlgSaveAs.FilterIndex = i
Set WshShell = CreateObject("WScript.Shell")
'SpecialPath = WshShell.SpecialFolders(16)
SpecialPath = "C:\CRM\Postboek\Ongekoppeld"
msgFileName = MySelectedItem.Subject
msgFileName = Replace(msgFileName, ":", "-")
Set oRegEx = CreateObject("vbscript.regexp")
oRegEx.Global = True
oRegEx.Pattern = "[\/:*?""<>|]"
'msgFileName = Trim(oRegEx.Replace(msgFileName, ""))
'msgFileName = Trim(oRegEx.Replace(msgFileName, ""))
If Len(strRecieved) = 0 Then
dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName & " - " & strSender & " - " & strDatum
ElseIf Len(strRecieved) > 0 Then
dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName & " - " & strRecieved & " - " & strDatum
End If
'dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName & " - " & strRecieved & " - " & strDatum
If dlgSaveAs.Show = -1 Then
strCurrentFile = dlgSaveAs.SelectedItems(1)
If Right(strCurrentFile, 4) <> ".pdf" Then
Response = MsgBox("Sorry, only saving in the pdf-format is supported." & _
vbNewLine & vbNewLine & "Save as pdf instead?", vbInformation + vbOKCancel)
If Response = vbCancel Then
wrdDoc.Close 0
If bStarted Then wrdApp.Quit
Exit Sub
ElseIf Response = vbOK Then
intPos = InStrRev(strCurrentFile, ".")
If intPos > 0 Then
strCurrentFile = Left(strCurrentFile, intPos - 1)
End If
strCurrentFile = strCurrentFile & ".pdf"
End If
End If
wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
strCurrentFile, _
ExportFormat:=17, _
OpenAfterExport:=False, _
OptimizeFor:=0, _
Range:=0, _
From:=0, _
To:=0, _
Item:=0, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=0, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
End If
Set dlgSaveAs = Nothing
wrdDoc.Close
If bStarted Then wrdApp.Quit
Set MyOlNamespace = Nothing
Set MySelectedItem = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing
Set oRegEx = Nothing
End Sub
This part gives the notification to the user if they want to save it and I actually just want it removed:
If dlgSaveAs.Show = -1 Then
strCurrentFile = dlgSaveAs.SelectedItems(1)
If Right(strCurrentFile, 4) <> ".pdf" Then
Response = MsgBox("Sorry, only saving in the pdf-format is supported." & _
vbNewLine & vbNewLine & "Save as pdf instead?", vbInformation + vbOKCancel)
If Response = vbCancel Then
wrdDoc.Close 0
If bStarted Then wrdApp.Quit
Exit Sub
ElseIf Response = vbOK Then
intPos = InStrRev(strCurrentFile, ".")
If intPos > 0 Then
strCurrentFile = Left(strCurrentFile, intPos - 1)
End If
strCurrentFile = strCurrentFile & ".pdf"
End If
End If
Here is a screenshot of what I want to be removed:
screenshot

Answer 1

Remove this part:
If Len(strRecieved) = 0 Then
dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName & " - " & strSender & " - " & strDatum
ElseIf Len(strRecieved) > 0 Then
dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName & " - " & strRecieved & " - " & strDatum
End If
'dlgSaveAs.InitialFileName = SpecialPath & "\" & msgFileName & " - " & strRecieved & " - " & strDatum
If dlgSaveAs.Show = -1 Then
strCurrentFile = dlgSaveAs.SelectedItems(1)
If Right(strCurrentFile, 4) <> ".pdf" Then
Response = MsgBox("Sorry, only saving in the pdf-format is supported." & _
vbNewLine & vbNewLine & "Save as pdf instead?", vbInformation + vbOKCancel)
If Response = vbCancel Then
wrdDoc.Close 0
If bStarted Then wrdApp.Quit
Exit Sub
ElseIf Response = vbOK Then
intPos = InStrRev(strCurrentFile, ".")
If intPos > 0 Then
strCurrentFile = Left(strCurrentFile, intPos - 1)
End If
strCurrentFile = strCurrentFile & ".pdf"
End If
End If
Set the file name you want below:
wrdApp.ActiveDocument.ExportAsFixedFormat OutputFileName:= _
___PUTYOURFILENAMEHERE___, _
ExportFormat:=17, _
OpenAfterExport:=False, _
OptimizeFor:=0, _
Range:=0, _
From:=0, _
To:=0, _
Item:=0, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=0, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False