Excel 2010 - Serien Mail - individuelle Anhänge Link in Excelzelle

F

FFFF

Grünschnabel
Hallo zusammen,

ich möchte an mehrere Kunden (Firmen) eine Mail schreiben. Folgende Kriterien müssen erfüllt werden:

- Betreff: "Standardtext" + Firmenname
- Textbody: Gleich bei jedem Empfänger
- Empfänger: Firma (Kunde) + Ticketsystem (CC, Intern, für Verwaltung)
- Anhänge: Individuell für jeden Kunden (Pfad für den Anhang in Excelzelle)
- Senden: Schaltfläche in Excel (SENDEN)

Ich habe mir von diesem Tutor den Code heruntergeladen und modifiziert:
http://www.youtube.com/watch?v=i-gvQQ0749Y

Der Aufbau / Inhalt meiner Exceldatei schaut wie folgt aus:
A2/3/4/... = Firmenname
B2/3/4/... = Mailadresse der Firma
C2/3/4/... = Mailadresse des Ticketsystems
D2/3/4/... = Betreff der Mail
E2/3/4/... = Text der Mail
F2/3/4/... = Pfad des Anhangs

Es funktioniert soweit alles, die Mails werden an alle Empfänger versand, der Betreff wird um den Firmennamen ergänzt und der Text wird korrekt eingefügt, alles aus der Excel Datei. Das einzige Problem ist, dass ich die Anhänge nur versenden kann wenn ich den Pfad direkt im Makro angebe. Trage ich die Zelle ein und

Ich möchte alle variablen Daten in der Exceltabelle pflegen, damit ich das Skript auch anderen Mitarbeitern geben kann.

Wie krieg ich das hin?
Ich kann mir vorstellen, dass ich die Excelzellen falsch formatiert habe, den Pfad anders angeben muss, die Variable String nicht passt....********?

Besten Dank schonmal im Voraus,

und hier der ganze Code:
Visual Basic: 
Sub Excel_Serial_Mail()


    Dim objOLOutlook As Object          'Steht für die Anwendung Outlook
    Dim objOLMail As Object             'Steht für die einzelnen E-Mails
    Dim lngMailNr As Long               'Zeile, in der die untereste E-Mail in Spalte A steht
    Dim lngZaehler As Long              'Zähler, welche Zeile gerade angesprochen wird
    Dim strAttachmentPfad1 As String    'So gehts mit Pfad direkt hier drinne.
    'Dim strAttachmentPfad1 As String   'Die Anhänge
    
    On Error GoTo ErrorHandler          'Bei einem Fehler, wird unten die Fehlerbehandlung angesprochen
    
    Set objOLOutlook = CreateObject("Outlook.Application")
    lngMailNr = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row  'Ermittlung unterste Zeile in Spalte A
    'strAttachmentPfad1 = Cells(lngZaehler, 6)                  'Pfade der Anhänge (geht nicht)
    strAttachmentPfad1 = "H:\Makros\Test.xls"                   'so gehts******!
        
    For lngZaehler = 2 To lngMailNr
        If Cells(lngZaehler, 2) <> "" Then
            Set objOLMail = objOLOutlook.CreateItem(olMailItem)
            With objOLMail
                .To = Cells(lngZaehler, 2)                                      'Empfänger AN
                .CC = Cells(lngZaehler, 3)                                      'Empfänger CC
                .BCC = ""                                                       'Empfänger BCC
                .Sensitivity = 0                                                'Vertraulichkeit (normal = 0)
                .Importance = 1                                                 'Wichtigkeit
                .Subject = Cells(lngZaehler, 4) & " - " & Cells(lngZaehler, 1)  'Betreff
                .BodyFormat = olFormatPlain                                     'E-Mail-Format
                .Body = Cells(lngZaehler, 5)                                    'Inhalt der Mail
                .Attachments.Add strAttachmentPfad1                             'Die Anhänge
                '.Attachments.Add Cells(lngZaehler, 6)                          'Die Anhänge
                .Send                                                           'Versand der Mail
                '.Display
            End With
            Set objOLMail = Nothing             'E-Mail-Objekt wird beendet
        End If
     Next lngZaehler                            'Zur nächsten E-Mail
     Set objOLOutlook = Nothing                 'Anwendung Outlook wird vaporisiert
        
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Number & " " & Err.Description & " " & Err.Source, _
        vbInformation, "Ein Fehler ist aufgetreten, aber Fabi ist nicht schuld! =)"
    Exit Sub
End Sub
 
Zuletzt bearbeitet von einem Moderator:
Ich könnte mir vorstellen, dass Excel an dieser Stelle ein Problem mit dem Typ hat. Cells liefert ein Range-Object. An vielen Stellen kann Excel damit umgehen wenn eigentlich der Inhalt der Range gewünscht ist (z.B. bei MsgBox), ggf. hier jedoch nicht. Um hier die richtige Funktionsweise sicherzustellen, erweitere deine Zeile mal so:
Visual Basic: 
.Attachments.Add Cells(lngZaehler, 6).Value
 
Hi,

danke für die fixe Antwort. Klappt nur leider nicht.

Ich bekomme diese Fehlermeldung:

1004 Anwendungs- oder objektdefinierte Fehler VBAProject
 
Was wirft denn Cells(lngZaehler, 6) im Überwachungsfenster aus?

Btw: Ich würde nie Cells ohne Qualifikator verwenden.
Wenn, dann mit ActiveSheet.Cells(lngZaehler, 6) blabla
 
Hi,

ich habe keine Überwachungsfenster aktiviert, also nicht wissentlich.

ABER: Es klappt****** ich habe den Code etwas geändert und die Variablenzuweisung in die Schleife eingebaut! Hier der funktionierende Code:


Sub Excel_Serial_Mail()


Dim objOLOutlook As Object 'Steht für die Anwendung Outlook
Dim objOLMail As Object 'Steht für die einzelnen E-Mails
Dim lngMailNr As Long 'Zeile, in der die untereste E-Mail in Spalte A steht
Dim lngZaehler As Long 'Zähler, welche Zeile gerade angesprochen wird

On Error GoTo ErrorHandler 'Bei einem Fehler, wird unten die Fehlerbehandlung angesprochen

Set objOLOutlook = CreateObject("Outlook.Application")
lngMailNr = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row 'Ermittlung unterste Zeile in Spalte A


For lngZaehler = 2 To lngMailNr
If Cells(lngZaehler, 2) <> "" Then
Set objOLMail = objOLOutlook.CreateItem(olMailItem)
With objOLMail
.To = Cells(lngZaehler, 2) 'Empfänger AN
.CC = Cells(lngZaehler, 3) 'Empfänger CC
.BCC = "" 'Empfänger BCC
.Sensitivity = 0 'Vertraulichkeit (normal = 0)
.Importance = 1 'Wichtigkeit
.Subject = Cells(lngZaehler, 4) & " - " & Cells(lngZaehler, 1) 'Betreff
.BodyFormat = olFormatPlain 'E-Mail-Format
.Body = Cells(lngZaehler, 5) 'Inhalt der Mail
Dim strAttachmentPfad1 As String
strAttachmentPfad1 = ActiveSheet.Cells(lngZaehler, 6)
.Attachments.Add strAttachmentPfad1 'Die Anhänge
.Send 'Versand der Mail
'.Display
End With
Set objOLMail = Nothing 'E-Mail-Objekt wird beendet
End If
Next lngZaehler 'Zur nächsten E-Mail
Set objOLOutlook = Nothing 'Anwendung Outlook wird vaporisiert

Exit Sub

ErrorHandler:
MsgBox Err.Number & " " & Err.Description & " " & Err.Source, _
vbInformation, "Ein Fehler ist aufgetreten, aber Fabi ist nicht schuld! =)"
Exit Sub
End Sub
 
Eine Kleinigkeit hätte ich noch:

ich würde gerne den Ausführen/Starten Button des Makros in die Excel Tabelle einbauen. Ich weiß aus dem oben genannten Video, dass es geht, allerdings nicht wie.

Google wollte mir auch nicht helfen. =(

Grüße
 
Deinen code in ein standard-modul schieben, die sub als public deklarieren, einen button auf dein excel-blatt zeichnen, rechtsclick drauf, makro zuweisen
 
Um antworten zu können musst du eingeloggt sein.

Neue Beiträge

Zurück