Regneark via e-mail (pdf)

Sendt et regneark som pdf via e-mail, automatisk

Nogle gange kunne det være lækkert af kunne sende et enkelt eller udvalgte faner til andre via mail.
Excel kan ikke selv klare denne opgave i ét hug, men det kan denne kode hjælpe dig med.

Bruger du Excel 2010 og nyere, kan koden bruges uden videre, men bruger du Excel 2007 skal du først hente en opdatering som giver mulighed for at gemme som PDF. Versioner før Excel 2007 understøttes ikke.
Scriptet er kun kompatibelt med 32 bit version af Excel.

Excel vedhæfter som standard hele projektmappen hvis du sender direkte fra Excel, men det er faktisk ikke særlig tit man har brug for dette.
Ofte er det kun det aktive ark eller et par markerede ark som man konvertere til pdf og sende via e-mail.

Der er mange ting som kan justeres i nedenstående kode, her er et udpluk.

Opsætning af e-mail via VBA

.To = Her skrives en modtager. Hvis denne er tom, sendes mailen til en valgfri modtager.
.CC = Her skrives en evt CC modtager
.BCC = Her skrives en evt Bcc modtager
.Subject = Her skrives emnet i meddelelsen
.Body = Her skrives selve meddelsens brødtekst

Ønsker du at mailen sendes automatisk når du aktiverer koden (selve mailen vises ikke, men sendes automatisk når koden aktiveres), skal du ændre
.Display
Til
.Send

Nedenstående kode skal placeres i et modul

'************Allan Thustrup Mortensen - Excel-regneark.dk ************
'*************************************************************

Sub LavPDFOgSendViaEmail()

Dim DataSti As String
Dim Filnavn As String
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders
Dim OutlookPrg As Object
Dim OutlookMail As Object
Set OutlookPrg = CreateObject("Outlook.Application")
Set OutlookMail = OutlookPrg.CreateItem(0)

DataSti = objFolders("desktop") & Application.PathSeparator
Filnavn = ActiveSheet.Name & ".pdf"

ActiveSheet.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=DataSti & Filnavn, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

On Error Resume Next
With OutlookMail
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = "Hermed fremsendes " & Filnavn
    .Body = "Hermed fremsendes " & Filnavn & vbCrLf & vbCrLf & "Med venlig hilsen" & vbCrLf & "Excel-regneark.dk"
    .Attachments.Add (DataSti & Filnavn)
    .Display
End With
On Error GoTo 0

Kill (DataSti & Filnavn)

Set OutlookMail = Nothing
Set OutlookPrg = Nothing
Set objFolders = Nothing
End Sub