macro der laver en e-mail med en vedhæftet fil i pdf LIGGENDE

Dine to kodelinjer er jo kode, så de kan ikke have noget at gøre med din makro.
Så jeg ville fortsætte med at skrive kode og glemme alt om makroer.

Jamen det er fordi jeg ikke har kunnet finde koder fo oprettelse af e-mail med vedhæftet pdf fil

Prøv denne der skal bare lige lave en mappe "setup"

Private Sub CommandButton2_Click()
'---------'
' Gem PDF '
'---------'

' Author - Philip Treacy  ::  http://www.linkedin.com/in/philiptreacy
' http://www.MyOnlineTrainingHub.com/vba-to-create-pdf-from-excel-worksheet-then-email-it-with-outlook
' Date - 14 Oct 2013
' Create a PDF from the current sheet and email it as an attachment through Outlook

Dim EmailSubject As String, EmailSignature As String
Dim CurrentMonth As String, DestFolder As String, PDFFile As String
Dim Email_To As String, Email_CC As String, Email_BCC As String, Email_Body As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim OutlookApp As Object, OutlookMail As Object
CurrentMonth = ""

' *****************************************************
' *****    You Can Change These Variables    *********
    EmailSubject = CurrentMonth    'Change this to change the subject of the email. The current month is added to end of subj line
    OpenPDFAfterCreating = False    'Change this if you want to open the PDF after creating it : TRUE or FALSE
    AlwaysOverwritePDF = False      'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
    DisplayEmail = True            'Change this if you don't want to display the email before sending.  Note, you must have a TO email address specified for this to work
    Email_To = Sheets("Setup").Range("B1").Value  'Change this if you want to specify To email e.g. ActiveSheet.Range("H1") to get email from cell H1
    Email_CC = Sheets("Setup").Range("B2").Value
    Email_BCC = Sheets("Setup").Range("B3").Value
    Email_Body = Sheets("Setup").Range("B12").Value
           
' ******************************************************
'----------------------------
' Prompt for file destination
'----------------------------
    DestFolder = Sheets("Setup").Range("B5").Value

'-------------------------------------------------------
'Current month/year stored in H6 (this is a merged cell)
'-------------------------------------------------------
    CurrentMonth = Sheets("Setup").Range("B4").Value

'----------------------------------------------------------
'Create new PDF file name including path and file extension
'----------------------------------------------------------
    If Sheets("Setup").Range("B5").Value = "" Then
        MsgBox "  Lagringsmappen eksisterer ikke." _
            & vbCrLf & vbCrLf & "  Vælg lagringsmappe.", _
            vbExclamation, "Vælg mappe"
       
        SaveFileInMap.Show
       
        MsgBox "  Gem PDF filen igen.", _
        vbExclamation, "Gem PDF igen"
       
        Exit Sub
    End If
   
    'PDFFile = DestFolder & Application.PathSeparator & CurrentMonth & ".pdf"
    PDFFile = DestFolder & Application.PathSeparator & Sheets("Setup").Range("B6").Value & ".pdf"
   

'-------------------------
'If the PDF already exists
'-------------------------
    If Len(Dir(PDFFile)) > 0 Then
        If AlwaysOverwritePDF = False Then
            OverwritePDF = MsgBox("  " & Sheets("Setup").Range("B6").Value _
            & vbCrLf & "  eksisterer allerede." _
            & vbCrLf & vbCrLf & "  Vil du overskrive PDF filen ?", _
            vbYesNo + vbQuestion, "PDF eksisterer allerede")
            On Error Resume Next

'-------------------------------------------------------------
'If you want to overwrite the file then delete the current one
'-------------------------------------------------------------
        If OverwritePDF = vbYes Then
            Kill PDFFile
        Else
            MsgBox "  Hvis du ikke overskriver PDF filen," _
            & vbCrLf & "  vil den ikke blive oprettet.", _
            vbExclamation, "Afslut"
            Exit Sub
        End If
        Else
            On Error Resume Next
            Kill PDFFile
        End If

        If Err.Number <> 0 Then
            MsgBox "  " & Sheets("Setup").Range("B4").Value _
            & vbCrLf & "  kan ikke overskrives." _
            & vbCrLf & vbCrLf & "  Er PDF filen åben ?" _
            & vbCrLf & vbCrLf & "  Luk PDF filen og prøv at sende den igen.", _
            vbExclamation, "PDF filen åben - Luk den"
            Exit Sub
        End If
    End If
   
'--------------
'Create the PDF
'--------------
    'On Error GoTo ud
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=OpenPDFAfterCreating
             
'---------------------'
' Åben lagringsmappen '
'---------------------'
    'On Error Resume Next
    'Call Shell("explorer.exe" & " " & Sheets("Setup").Range("B5").Value, vbMaximizedFocus)
    'Exit Sub
'---------------------------------------------
'Create an Outlook object and new mail message
'---------------------------------------------
    'On Error GoTo ud
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
       
'------------------------------------------
'Display email and specify To, Subject, etc
'------------------------------------------
    With OutlookMail
        .display
        .To = Email_To
        .CC = Email_CC
        .BCC = Email_BCC
        .Subject = EmailSubject & CurrentMonth
        .Body = Email_Body
        .Attachments.Add PDFFile
               
        If DisplayEmail = False Then
            Application.Wait (Now + TimeValue("0:00:03"))                  ' Wait for e-mail to take focus
            .Send
        End If
    End With
ud:

End Sub

Desværre:
1)
Den er til Excel til outlook - Jeg bruger Access Rapport til outlook
2)
Application.PathSeparator virker ikke

https://www.youtube.com/watch?v=iZz2wiwbfVs

prøv at kigge på denne

Han bruger DoCmd.SendObject. Den benytter jeg selv mange steder men den kan ikke umiddelbart sende en rapport side som vedhæftet pdf.
EMailDatabaseObject er genial men giver desværre ikke liggende pdf

Sæt rapportens sideopsætning til Liggende og gem den. Så vil den sendes liggende.
Det kan gøres med én linje:

Docmd.SendObject acSendReport, "Rapportnavn", acFormatPDF, "john.joe@example.com", , , "Emne", "Rapport som aftalt.", False

EMailDatabaseObject gør det samme blot kaldt som en macro.

Hvis du vil mere end det, må du i gang med CDO. Daniel har en god forklaring:

https://www.devhut.net/vba-cdo-mail/

Det er dog ikke helt ligetil, hvis du vil sende via Exchange Online eller Gmail på grund af deres skrappe sikkehedskrav og 2-faktor godkendelse, så du skal oprette særlige adgangskoder til brug med "apps".

Ultimativt kan du bruge et e-mail API som franske MailJet. Det fungerer mageløst godt, men er en større omgang at programmere til, desværre især i VBA.

Docmd.SendObject acSendReport, "Rapportnavn", acFormatPDF, "john.joe@example.com", , , "Emne", "Rapport som aftalt.", False


Viker perfekt
1000 tak for hjælpen