Avatar billede per2edb Ekspert
Oprettet i går kl. 17:48 Der er 3 kommentarer

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

Jeg har en integreret makro med navnet: EMailDatabaseObject

Den opretter en e-mail og vedhæfter min Rapport som en pdf fil
Desværre er pdf filen stående hvor jeg ønsker den liggende

Jeg e total ny på macroer
Kan i hjælpe med at tilsætte en kode så pdf bliver liggende

Jeg har fundet disse koder men de laver ikk e-mailen

Forms("FR_Print").Printer.Orientation = acPRORLandscape
DoCmd.PrintOut acPages, 1, 1, , 1
Avatar billede Gustav Ekspert
Skrevet i går kl. 19:25 #1
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.
Avatar billede per2edb Ekspert
Skrevet i går kl. 20:24 #2
Jamen det er fordi jeg ikke har kunnet finde koder fo oprettelse af e-mail med vedhæftet pdf fil
Avatar billede bjarnehansen Seniormester
Skrevet i går kl. 21:29 #3
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
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Dyk ned i databasernes verden på et af vores praksisnære Access-kurser

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester