VBA to save as PDF and mail PDF to Specific recipient/s from Specific Account with Specific Signature

WERNER SLABBERT

Board Regular
Joined
Mar 3, 2009
Messages
107
Hi there ....
i recently found this thread
"
HTML:
https://www.mrexcel.com/forum/general-excel-discussion-other-questions/710212-vba-code-convert-excel-pdf-email-attachment.html
"
that does more or less what i want in my VBA but implementing it into my Current VBA is no easy feat,
would anyone be so kind as to help me piece it together... i would like the Macro to in addition send the saved pdf to a specific Recipient / s with a selected outlook account and specific signature in my case called "Nexus"

Here is my current Macro, it works great at saving the PDF and sends a mail, but no attachment and no specific account or sig... please help me...
Code:
Option Explicit

Private Const CSIDL_DESKTOP = &H0
Private Type EMID
    cb As Long
    abID As Byte


End Type
    Private Type ITEMIDLIST


mkid As EMID
    End Type


Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long


Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _
    "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Function GetSpecialfolder(CSIDL As Long) As String


Dim r As Long, Path$
Dim IDL As ITEMIDLIST


        'Get the special folder
        r = SHGetSpecialFolderLocation(100, CSIDL, IDL)
        If r = 0 Then


        'Create a buffer
        Path$ = Space$(512)


'Get the path from the IDList
r = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Path$)


        'Remove the unnecessary chr$(0)'s
        GetSpecialfolder = Left$(Path, InStr(Path, Chr$(0)) - 1)


        Exit Function


    End If


GetSpecialfolder = ""


End Function
Sub SaveIt()
  
    On Error Resume Next 'In case it already exists
MkDir GetSpecialfolder(CSIDL_DESKTOP) & "\Famous_Brands" & "\" & Range("C7").Value
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False


    Dim Filename As String
    Dim Path As String
    Dim i As Integer
    Dim Mail_Object
    Dim Email_Subject
    Dim o As Variant
    
    Filename = Format(Date, "yyyy_mm_dd") & "_" & Range("J7").Value & "_" & Range("J8").Value
    Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
    
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=Path & "\Famous_Brands" & "\" & Range("C7").Value & "\" & Filename & ".Pdf", _
            Quality:=xlQualityStandard, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True


    ActiveWorkbook.SaveAs Filename:=Path & "\Famous_Brands" & "\" & "Complete_Job_Card_2018", _
                            FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                            Password:="", _
                            WriteResPassword:="", _
                            ReadOnlyRecommended:=False, _
                            CreateBackup:=False
                                                      
        ActiveWorkbook.SaveAs Filename:=Path & "\" & "Complete_Job_Card_2018", _
                            FileFormat:=xlOpenXMLTemplateMacroEnabled, _
                            Password:="", _
                            WriteResPassword:="", _
                            ReadOnlyRecommended:=False, _
                            CreateBackup:=False
                                        
            Set Mail_Object = CreateObject("Outlook.Application")
        With Mail_Object.CreateItem(o)
            .Subject = "Famous Brands Repair Job Card" ' CHANGE TO SUIT
            .To = "receptionpta@nexusgroup.co.za" 'CHANGE TO SUIT
            .Body = "Machine Repaired and Ready for collection or courier." & Chr(13) & Chr(13) & "Regards," & Chr(13) & "Werner Johan Slabbert" & Chr(13) & "Nexus Technical" 'Change comments to suit
            .Attachments.Add Filename
            .Send
    End With
        MsgBox "E-mail successfully sent", 64
        Application.DisplayAlerts = False
Set Mail_Object = Nothing


 
End Sub
 
Hey Eric.
i have downloaded your workbook, but i have been swamped at work the past week or so, as soon as i have a gap i will run through it to see.

thank you again for you patience and help in this project.


I have downloaded your project and I will look it over asap.
Please let me if the Excel workbook I created is working for your task. I would be happy to adapt it to better suit your needs.

Eric
 
Upvote 0

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Hi Eric

when you've had a chance to look at my original workbook, would you maybe guide me through the process of incorporating your code alongside my ( frankenHacked ) macro to make it all one button operation. eg: Print,Save & Email.

also i had a look and your code works a treat. just want to know would it be possible to automate some of the steps like "set" a specific Email to send from ( as this would always be my work mail and signature ). as well as auto choose/attach the "saved" PDF as saved by my code. just basically keep the user interaction to the bare minimum. you know like a one click solution ?
just a couple of thoughts i had, because in South Africa we kinda have to spoon feed everything for everyone... :confused:

reason for this is, i will not always be working with the workbook and i would like to simplify it for the ...uhm ... lets just say technologically challenged user within our company....



No worries Werner,
Always happy to help out a fellow Excel & VBA enthusiast.
 
Upvote 0

Forum statistics

Threads
1,223,893
Messages
6,175,246
Members
452,623
Latest member
cliftonhandyman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top