VBA Send mail og vedhæft fil

Hej lstevns
Jeg bruger denne kode, den første del gemmer filen med navnet stående i H1 kan rettes. Og som en fil uden makro dette kan rettes ved at skrive 52 i stedet for 51. Den næste del er mail delen. Her sender outlook til de 3 adresse der står i .To = Sheets kan rettes til alt efter hvor mange mail adresser du skal sende til. .Subject står i cele H1 kan rettes. Hele teksten (Body) står i N1. Og de andre celler i N indholder i mit tilfælde "Med venlig hilsen" & Navn

Sub Rektangelafrundedehjørner1_Klik()

ThisFile = Range("h1").Value

Application.Dialogs(xlDialogSaveAs).Show ThisFile, 51

Sheets("Prisliste").Select
    Mail_workbook_Outlook
End Sub

Sub Mail_workbook_Outlook()
'her er koden til at sende mail
    Dim Edress As String, Subj As String
    Dim OutlookOBJ As Object, mItem As Object
    '---------------------------------------------'
    Set OutlookOBJ = CreateObject("Outlook.Application")
    Set mItem = OutlookOBJ.CreateItem(olMailItem)
    With mItem
   
        .To = Sheets("Prisliste").Range("H2").Value & "; " & Range("i4").Value & "; " & Range("i5").Value
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Prisliste").Range("h1").Value
       
        .Body = Range("n1").Value & vbNewLine & vbNewLine & Range("n4").Value & vbNewLine & _
        Range("n5").Value & vbNewLine & Range("n6").Value & vbNewLine & Range("n7").Value & vbNewLine & _
        Range("n8").Value
       
        '.Send                              '<-- .Send will auto send email without review
                               
ThisWorkbook.Save
        .Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
        .Send
    End With

End Sub

Hej Klaus

Jeg bruger denne kode, som virker fint mht. at gemme og vedhæfte Excel ark som PDF. men jeg kan bare ikke få Signature ind i mailen??

Sub SendWorkSheetToPDF()
'Update 20131209
Dim Wb As Workbook
Dim fileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object


On Error Resume Next
Set Wb = Application.ActiveWorkbook
fileName = Wb.FullName
xIndex = VBA.InStrRev(fileName, ".")
If xIndex > 1 Then fileName = VBA.Left(fileName, xIndex - 1)
fileName = fileName & "_" + ActiveSheet.Name & ".pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
    .To = "xx@Outlook.dk"
    .CC = ""
    .BCC = ""
    .Subject = "Godkendt lønaftale, " & Range("G10") & ", MA nr.: " & Range("G8")
    .Body = "Godkendt lønaftale." & vbNewLine & sig
    .Attachments.Add fileName
    .Attachments.Add wb2.FullName
    .Display
    '.Send
End With
Kill fileName
Set OutlookMail = Nothing
Set OutlookApp = Nothing
End Sub

Kan man ikke indfører en kode i min kode som kan hente signature?

Hej lstevns
Det ved jeg ikke, hvordan hente signatur. Står den i en celle?

KW

Nej, den skal bare hente i Outlook, hvor der er oprettet basis signature

Ok sådan, det ved jeg ikke hvordan du gør.
KW

Hej Istevns,

Jeg fik hjælp til det i denne case:
https://www.computerworld.dk/eksperten/spm/1036384
Tak til ebea.

Her er en kode der opretter en PDF fil og mailer den.
Den er lidt rodet, der er lidt flere muligheder, som er udelukket med et '.
Men tror du kan finde ud af det.

Kan være den skal tilpasses lidt til dit behov.

Sub Gem_som_PDF_OG_mail_dansk()
'
' Gem_som_PDF_OG_mail Makro
'
' Dette generer en PDf fil og gemmer den i samme mappe som TO Kalk arket, med nyt TO nummer hver gang.
Dim thisPath As String, docName As String, Title As String

Title = "TO " & Sheets("TO dansk").Range("C4") & " - " & Range("C6") & " - " & Format(Range("C5"), "dd-mmm-yyyy")

'thisPath = Left(Application.ActiveWorkbook.Path, InStrRev(Application.ActiveWorkbook.Path, "\") - 1) ' Dette sætter stien en mappe tilbage
thisPath = Application.ActiveWorkbook.Path

docName = thisPath & "\TO Aftalesedler\TO " & Sheets("TO dansk").Range("C4") & " - " & Range("C6") & " - " & Format(Range("C5"), "dd-mmm-yyyy") ' \TO Aftalesedler går ind i mappen TO aftalesedler og genner filen med start af filnavnet med TO


Sheets("TO dansk").Activate
'Range("C4").Select
With Sheets("TO dansk")
    .ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=docName, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False 'True
End With



' Nedenstående laver en midlertidig PDF fil, som sendes og slettes igen.

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Signature As String 'Title As String
  Dim OutlApp As Object
  Dim strbody As String
 
  'Titel på email kan angives i nedenstående celle
  'Title = Range("B4") & "  -  " & Range("D4")

  'Angiv PDF filnavn
  'PdfFile = ActiveWorkbook.FullName
  PdfFile = docName '& ".pdf"
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = PdfFile & ".pdf"

  'Eksporter aktive Ark som PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard ', IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With

  'Hvis Outlook er åben, så brug den
  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

    'Her indsættes den HTML tekst som skal inkluderes i Body sektionen
        strbody = "<BODY style=font-size:10pt;font-family:Calibri>Hej" & _
        "<br><br>Hermed fremsendes tilbud på aftalte tillægsordre, som PDF format.<br><br>" & _
        "Venligst bekræft om tillægsordren kan godkendes og at vi kan gå i gang med den. <br><br>" & _
        "Ser frem til at høre fra dem."

    'Forbered e-mail med PDF vedhæftning
    With OutlApp.CreateItem(0)
      .Display
      .To = "" 'Range("G4").Value ' <-- Refererer til cellen med email adresse for personen der modtager mailen
      .CC = "" ' <-- Indsæt anden modtager her
      .Subject = Title
      .HTMLBody = strbody & "<br>" & .HTMLBody
      .Attachments.Add PdfFile
      '.Send

    'Afsendelse, hvis man laver den med en mailadresse, så kan den sende direkte. Så skal man lige huske .Send oven over også.
  ' On Error Resume Next
  ' Application.Visible = True
  ' If Err Then
  '  CreateObject("WScript.Shell").Popup "E-mail'en blev ikke sendt", 1
  '  Else
  '  CreateObject("WScript.Shell").Popup "E-mail'en blev sendt", 1
    ' .Send

    'End If
    On Error GoTo 0
  End With

  'Sletter oprettede PDF fil
  'Kill PdfFile

  'Luk Outlook, hvis det blev startet af denne kode
  If IsCreated Then OutlApp.Quit

  'Tøm variabel hukommelsen
  Set OutlApp = Nothing
 
'  Range("E4").Select
'  ActiveCell.FormulaR1C1 = "P"
'  ActiveCell.FormulaR1C1 = "Ingen fejl"
' Range("A1").Select

End Sub