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



## FFFF (24. Oktober 2013)

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:

```
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
```


----------



## HonniCilest (24. Oktober 2013)

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:

```
.Attachments.Add Cells(lngZaehler, 6).Value
```


----------



## FFFF (24. Oktober 2013)

Hi,

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

Ich bekomme diese Fehlermeldung:

1004 Anwendungs- oder objektdefinierte Fehler VBAProject


----------



## Zvoni (24. Oktober 2013)

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


----------



## FFFF (25. Oktober 2013)

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


----------



## Zvoni (25. Oktober 2013)

Dann auch als erledigt markieren


----------



## FFFF (25. Oktober 2013)

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


----------



## Zvoni (25. Oktober 2013)

Deinen code in ein standard-modul schieben, die sub als public deklarieren, einen button auf dein excel-blatt zeichnen, rechtsclick drauf, makro zuweisen


----------



## FFFF (25. Oktober 2013)

Ok,

alles Funktioniert!

besten Dank super!

(Musste nur ein Rechteck zeichnen und das Makro zuweisen)


----------

