Microsoft Excel

Herbers Excel/VBA-Archiv

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

Mail per VBA mit PDF-Anhang | Herbers Excel-Forum


Betrifft: Mail per VBA mit PDF-Anhang von: Ralf Junglas
Geschrieben am: 05.02.2012 16:31:57

Hallo,

ich werkle schon geraume Zeit an folgendem Problem rum:

Ich muss für einen Kunden aus einer Excel-Mappe heraus eine Mail versenden können.
Dabei gibt es folgende Bedingungen:

1. Als Attachement gibt es eine PDF-Datei, die vorher erzeugt wurde.
(Name und Speicherpfad sind bekannt)

2. Die Anwender haben als Mail-Client meistens Novell Groupwise oder Lotus Notes,
selten auch MS Outlook (muss also unabhängig von dieser Software funktionieren).

3. Es muss übergeben werden: eine Empfänger-Adresse, ein Subject und das Attachement.

Der Befehl Application.Dialogs(xlDialogSendMail).Show kommt nicht in Frage, da Attachements
nicht definiert werden können.

Ich habe beim Suchen die Windows API-Funktion ShellExecute gefunden.
Aber in keiner Dokumentation stand die Übergabe eines Attachements erläutert.

Ich bin für alle Ideen und Lösungsansätze sehr dankbar.

Grüße
Ralf

  

Betrifft: AW: Mail per VBA mit PDF-Anhang von: Josef Ehrensberger
Geschrieben am: 05.02.2012 16:38:24



« Gruß Sepp »



  

Betrifft: AW: Mail per VBA mit PDF-Anhang von: Ralf Junglas
Geschrieben am: 05.02.2012 22:14:08

Hallo Sepp,

vielen Dank für Deinen Hinweis.
Ich habe auch schon überlegt, Blat zu benutzen (auch ein bekanntes Plattform-unabhängiges Tool)
zu benutzen, da ich damit Erfahrungen habe. Ich möchte aber, da es um ca. 250 Anwender geht,
nichts mit zusätzlichen Installationen etc. zu tun haben.
Daher bevorzuge ich eine Lösung, die ich mit VBA-Bordmitteln hinbekomme.

Gruß
Ralf


  

Betrifft: AW: Mail per VBA mit PDF-Anhang von: Josef Ehrensberger
Geschrieben am: 05.02.2012 22:21:06


Hallo Ralf,

für CDO braucht nichts installiert zu werden!




« Gruß Sepp »



  

Betrifft: AW: Mail per VBA mit PDF-Anhang von: Ralf Junglas
Geschrieben am: 06.02.2012 21:55:37

Hallo Sepp,

sorry, hab es mir nicht so genau angesehen, aber Du hast Recht.
Wenn ich etwas mehr Zeit habe, werde ich es ausprobieren.

Vielen Dank noch mal.

Grüße
Ralf


  

Betrifft: AW: Mail per VBA mit PDF-Anhang von: Ralf Junglas
Geschrieben am: 08.02.2012 21:59:46

Hallo Sepp,

ich habe die Prozedur nach Vorlage entwickelt:

Sub Mail_Senden()
    Dim objMessage As Object
    
    Set objMessage = CreateObject("CDO.Message")
        
    objMessage.Subject = "Example CDO Message"
    objMessage.From = "mail@compucare-ac.de"
    objMessage.To = "mail@compucare-ac.de"
    objMessage.TextBody = "This is some sample message text."
    
    objMessage.AddAttachment "D:\CC\Kunden\regio iT\Bestellungen aus Warenkorb\Test.pdf"
    
    objMessage.Send
End Sub
Die Bibliothek ist per Verweis eingebunden, aber das Senden klappt nicht.
Es kommt auch kein Err-Code zurück.

Hast Du eine Idee?

Grüße
Ralf


  

Betrifft: AW: Mail per VBA mit PDF-Anhang von: Josef Ehrensberger
Geschrieben am: 08.02.2012 22:07:52


Hallo Ralph,

ich glaube, da fehlt noch einiges, bei mir sieht der Code z. B. so aus.

' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

'Don't Change!
Private Const cstrSchema As String = "http://schemas.microsoft.com/cdo/configuration/"
'End Don't Change!

Private Const cstrSMTPServer As String = "mail.provider.com" 'Fill in your SMTP-Server!
Private Const cstrUSERNAME As String = "Your Username" 'Fill in your Mailaccount Username
Private Const cstrPASSWORD As String = "Your Password" 'Fill in your Mailaccount Password
Private Const cstrADDRESS As String = "name@domain.com" 'Your Mail-Address

Sub sendMail_CDO()
  'original code from http://www.rondebruin.nl/cdo.htm
  Dim rng As Range, rngF As Range
  Dim objMsg As Object, objConf As Object
  Dim vntFields As Variant, strBody As String
  Dim vntAttach As Variant, lngIndex As Long
  
  'Body - always use vbCrLf or vbNewLine to separate lines, don't use vbLf!
  Const strMsg As String = vbCrLf & vbCrLf & "Anbei die Datei zur Einsicht." & vbCrLf & vbCrLf & _
    "Mit freundlichen Grüßen." & vbCrLf & "Ich"
  
  'Attachment(s)
  'One File
  Const cstrAttachment As String = "C:\Testfile.txt"
  
  ''More Files
  'Const cstrAttachment As String = "C:\Testfile.txt;C:\AnotherFile.pdf"
  
  ''None
  'Const cstrAttachment As String = ""
  
  On Error GoTo ErrExit
  
  Set objMsg = CreateObject("CDO.Message")
  Set objConf = CreateObject("CDO.Configuration")
  
  objConf.Load -1 ' CDO Source Defaults
  Set vntFields = objConf.Fields
  With vntFields
    .Item(cstrSchema & "sendusing") = 2
    .Item(cstrSchema & "smtpserver") = cstrSMTPServer
    .Item(cstrSchema & "smtpserverport") = 25
    
    'When you also get the Authentication Required Error you can add this three lines.
    ' .Item(cstrSchema & "smtpauthenticate") = 1
    ' .Item(cstrSchema & "sendusername") = cstrUSERNAME
    ' .Item(cstrSchema & "sendpassword") = cstrPASSWORD
    
    .Update
  End With
  
  With Application
    .EnableEvents = False
    .ScreenUpdating = False
  End With
  
  With Sheets("Tabelle1")
    Set rngF = .Range(.Cells(2, 8), .Cells(.Cells(.Rows.Count, 8).End(xlUp).Row, 8))
  End With
  
  'Mailadressen stehen in Spalte H, Namen mit Anrede in Spalte G
  For Each rng In rngF
    If rng Like "*@*.*" Then
      With objMsg
        strBody = "Sehr geehrte" & IIf(Left(rng.Offset(0, -1).Text, 1) = "F", " " & _
          rng.Offset(0, -1).Text, "r " & rng.Offset(0, -1).Text) & "!" & strMsg
        
        Set .Configuration = objConf
        .To = rng.Text
        .CC = ""
        .BCC = ""
        .From = cstrADDRESS 'Absender
        .Subject = "Testmail" 'Betreff
        .TextBody = strBody
        
        If Len(cstrAttachment) Then
          vntAttach = Split(cstrAttachment, ";")
          For lngIndex = 0 To UBound(vntAttach)
            If Dir(vntAttach(lngIndex), vbNormal) <> "" Then .AddAttachment vntAttach(lngIndex)
          Next
        End If
        
        ' ' Set importance or Priority to high
        ' .Fields("urn:schemas:httpmail:importance") = 2
        ' .Fields("urn:schemas:mailheader:X-Priority") = 1
        '
        ' ' Request read receipt
        ' .Fields("urn:schemas:mailheader:return-receipt-to") = cstrADDRESS
        ' .Fields("urn:schemas:mailheader:disposition-notification-to") = cstrADDRESS
        '
        ' ' Update fields
        ' .Fields.Update
        
        .Send
      End With
    End If
  Next
  
  ErrExit:
  
  If Err.Number <> 0 Then
    MsgBox "Fehler:" & vbTab & Err.Number & vbLf & vbLf & Err.Description & _
      vbLf & vbLf, vbExclamation, "Fehler"
  End If
  
  With Application
    .EnableEvents = True
    .ScreenUpdating = True
  End With
  
  Set rng = Nothing
  Set rngF = Nothing
  Set objConf = Nothing
  Set objMsg = Nothing
End Sub






« Gruß Sepp »