Save to PDF and attach to mail

[Keoxes]

Hi trying to utilize the following code but seems to be hitting a bug somewhere

Issue 1.
The code is meant to be executed by pressing a button. Which is on Sheet 2 and the page that gets PDF-ed is Sheet 1. The code works perfectly for this part but saves it in random folders depending on where the last save was made for some reason. I would like it to save in any users home folder by creating a directory called "Quotes". Which means i need VBA for creating the directory first here C:\users\%username%\documents\quotes and then amend the filepath to be always this. I am using the CreateFolder function here so that i dont have to check if the folderpath exists or not, instead of MkDir

Issue 2.

In the same flow once the file is saved to the location to trigger outlook and create a new mail with the save pdf attached. The code i have below doesnt open outlook or prompt for an error message.

Public Sub SaveToPDFAndMail()
Application.ScreenUpdating = False 'Turn off screen updating


Dim tDate As String
Dim CName As String
Dim FName As String
Dim OutApp As Object
Dim OutMail As Object


Sheets("Sheet1").Select ' Select sheet that you want to save to PDF
tDate = Format(DateTime.Now, "yyyymmdd_hhmm") 'Format Today's date for filename
CName = Sheets("Sheet1").Range("C16").Value
FName = CName & "_Quote_" & tDate 'create filename string

CreateFolder(C:\users\%username%\documents\Quotes)


'select and save sheet to PDF using filename from FName string
'(Needs to change to filepath to save in users document folder in ENVIRON(HOMEPATH)\documents\%Cname% folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\users\%username%\documents\Quotes2" & FName, Quality:=xlQualityStandard

Sheets("Sheet2").Select 'Reselect frontpage

Application.ScreenUpdating = True 'Turn on screenupdating
MsgBox ("Your Quote named " & FName & " has been saved to your documents folder.") 'Display a message box outlining what the PDF has been called.


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


      With OutMail
        If Signature = True Then .Display
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Cocacola" & CName & "Quote"
        .BodyFormat = olFormatHTML 'send HTML message
        .HTMLBody = "Hi, <BR> Please see attached quote requested for" & CName & "."
        .Attachments.Add FName


    Set OutMail = Nothing
    Set OutApp = Nothing


End Sub

 

[wideboydixon]

Fixed up a bit. Hopefully enough to get it working:

Public Sub SaveToPDFAndMail()

Application.ScreenUpdating = False 'Turn off screen updating

Dim tDate As String
Dim CName As String
Dim FName As String
Dim DName As String
Dim OutApp As Object
Dim OutMail As Object

Sheets("Sheet1").Select ' Select sheet that you want to save to PDF
tDate = Format(DateTime.Now, "yyyymmdd_hhmm") 'Format Today's date for filename
CName = Sheets("Sheet1").Range("C16").Value
FName = CName & "_Quote_" & tDate 'create filename string

DName = Environ("USERPROFILE") & "\Documents\Quotes" ' Generate folder name
If Dir(DName, vbDirectory) = "" Then MkDir DName ' Create folder if it's not there

'select and save sheet to PDF using filename from FName string
'(Needs to change to filepath to save in users document folder in ENVIRON(HOMEPATH)\documents\%Cname% folder
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=DName & "\" & FName & ".pdf", Quality:=xlQualityStandard

Sheets("Sheet2").Select 'Reselect frontpage

Application.ScreenUpdating = True 'Turn on screenupdating
MsgBox ("Your Quote named " & FName & " has been saved to your documents folder.") 'Display a message box outlining what the PDF has been called.

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

With OutMail
    'If Signature = True Then .Display
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Cocacola" & CName & "Quote"
    .BodyFormat = 2 'send HTML message
    .HTMLBody = "Hi, Please see attached quote requested for " & CName & "."
    .Attachments.Add DName & "\" & FName & ".pdf"
    .Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

WBD