Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Werkzeug
BildScreenshot zu Werkzeug Werkzeug-Seite mit Beispielarbeitsmappe aufrufen

PDF als Mail Anhang in Lotus Noes

Betrifft: PDF als Mail Anhang in Lotus Noes von: Rene
Geschrieben am: 14.08.2014 00:03:02

Hallo zusammen

Mit dem unten genannten Code ist es mir möglich aus Excel heraus eine Mail via Lotus Notes mit einem excel sheet als Anhang zu versenden ,das funktioniert soweit auch prima .Ich benötige nun etwas Hilfe.
Ich möchte gerne das excel Blatt ald PDF Anhang in der Mail und nicht die xlsm Datei ,wie müsste der Code geändert werden ?

die Datei wird bereits als pdf auf einem Zielornder gespeichert ,welches ebenso problemlos funktioniert.

Vielen Dank René

Sub druck()
       'Blatt Drucken und Versionsnummer um eins hoch zählen
      Sheets("WKZ").Select
       ActiveSheet.Unprotect "wkz"
     [C2] = [C2] + 1 'Versionsnummer um 1 hochzählen
ActiveWindow.SelectedSheets.PrintOut _
Copies:=1, Collate:=True 'Drucken
    'Blatt Speichern
    ChDrive "C"
    ChDir "C:\WKZ Backup\"
    DName = [E2]
    
    'Blatt als PDF in Zielordner speichern
    ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=DName & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
    
    Sheets("WKZ").Protect "wkz"
    
 
'
Sub SendWithLotus()
   Dim noSession As Object, noDatabase As Object, noDocument As Object
   Dim obAttachment As Object, EmbedObject As Object
   Dim stSubject As Variant, stAttachment As String
   Dim vaRecipient As Variant, vaMsg As Variant
 
   Const EMBED_ATTACHMENT As Long = 1454
   Const stTitle As String = "Status Active workbook"
   Const stMsg As String = "The active workbook must first be saved " & vbCrLf _
         & "before it can be sent as an attachment."
 
   'Check if the active workbook is saved or not
 
   'If the active workbook has not been saved at all.
   If Len(ActiveWorkbook.Path) = 0 Then
      MsgBox stMsg, vbInformation, stTitle
      Exit Sub
   End If
 
   'If the changes in the active workbook has been saved or not.
   ActiveWorkbook.Save
   
   'If ActiveWorkbook.Saved = False Then
      'If MsgBox("Möchten Sie die Datei speichern bevor die e mail versendet wird?", _
          '  vbYesNo + vbInformation, stTitle) = vbYes Then _
           ' ActiveWorkbook.Save
  ' End If
 
   'Get the name of the recipient from the user.
   '==========================================geändert=====================================
   'Do
      'vaRecipient = Application.InputBox( _
            'Prompt:="Please add the name of the recipient such as:" & vbCrLf _
            '& "excel@microsoft.com or just the name if it's internally.", _
            'Title:="Recipient", Type:=2)
   'Loop While vaRecipient = ""
   '==========================================geändert=====================================
   vaRecipient = "test@test.de"
 
   'If the user has canceled the operation.
   If vaRecipient = False Then Exit Sub
 
   'Get the message from the user.
   '==========================================geändert=====================================
   'Do
      'vaMsg = Application.InputBox( _
         '   Prompt:="Please enter the message such as:" & vbCrLf _
          '  & "Enclosed please find the weekly report.", _
          '  Title:="Message", Type:=2)
   'Loop While vaMsg = ""
   '===========================================geändert======================================
   vaMsg = "Werkzeugstatus wurde aktuallisiert auf Laufwerk P:Werkzeuge/Statusbericht "
 
   'If the user has canceled the operation.
   If vaMsg = False Then Exit Sub
 
   'Add the subject to the outgoing e-mail which also can be retrieved from the users
   'in a similar way as above.
   'stSubject = "Weekly report"
   stSubject = "Werkzeug Statusbericht "
 
   'Retrieve the path and filename of the active workbook.
   stAttachment = ActiveWorkbook.FullName
 
   'Instantiate the Lotus Notes COM's Objects.
   Set noSession = CreateObject("Notes.NotesSession")
   Set noDatabase = noSession.GETDATABASE("", "")
 
   'If Lotus Notes is not open then open the mail-part of it.
   If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
 
   'Create the e-mail and the attachment.
   Set noDocument = noDatabase.CreateDocument
   'Set obAttachment = noDocument.CreateRichTextItem("stAttachment")
   'Set EmbedObject = obAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
 
   'Add values to the created e-mail main properties.
   With noDocument
      .Form = "Memo"
      .SendTo = vaRecipient
      .CopyTo = ("testmail@test.com, testmail2@test.com, testmail3@test.com")
      .Subject = stSubject
    .BlindCopyTo = ("testmail@test.com, testmail2@test.com, testmail3@test.com")
      '.BlindCopyTo = ("testmail@mail.com", "testmail2@mail.com", "testmail3@testmail.com")
      .Body = vaMsg
      .SaveMessageOnSend = True
   End With
 
   'Send the e-mail.
   With noDocument
      .PostedDate = Now()
      .Send 0, vaRecipient
   End With
 
   'Release objects from the memory.
   Set EmbedObject = Nothing
   Set obAttachment = Nothing
   Set noDocument = Nothing
   Set noDatabase = Nothing
   Set noSession = Nothing
 
   'Activate Excel for the user.
   AppActivate "Microsoft Excel"
 
   
   MsgBox "Die e-mail wurde erfolgreich erstellt und versendet .", vbInformation
   Sheets("WKZ").Select
   ActiveSheet.Protect "wkz"
End Sub

  

Betrifft: AW: PDF als Mail Anhang in Lotus Noes von: Rudi Maintaire
Geschrieben am: 14.08.2014 11:11:40

Hallo,
wahrscheinlich mit
Set obAttachment = noDocument.CreateRichTextItem(curdir &"\" &[E2] &".pdf")

Gruß
Rudi


  

Betrifft: AW: PDF als Mail Anhang in Lotus Noes von: Rene
Geschrieben am: 14.08.2014 18:37:45

Hallo Rudi,

Vielen Dank ,klappt wunderbar


Danke Rene