title image


Smiley email nur an bestimmte empfänger gem. eintrag in spalte a
hallo spotlight-er



verschicke mit einer excel-adresse an verschiedene empfänger

dateien und über outlook.

funktioniert auch gut, moechte es jedoch nur noch ein klein

wenig erweitern.

also:

ab b2 stehen die emailempfänger

ab c2 der jeweilige betreff

ab d2 der jeweilige mail-text - body



es soll jetzt in spalte a vor der email-adresse, die auch

ein email erhalten soll, ein "x" eingetragen werden.

also: wo kein X > auch keine email



wie muesste ich diese abfrage passend einbauen



hier der komplette code (mit noch weiteren features )



vielen dank für einen tip

stefan



CODESub Excel_Serienmail_mit_mehreren_Anlagen_mit_Fehlermeldung_via_Outlook_Senden()

'Variablendefinition

Dim fs As Object, F As Object

Dim OutApp As Object, mail As Object

Dim i As Integer, y As Integer, Msg As Integer

Dim Nachricht As Variant

Dim AWS As String

Dim AnzEmpfänger As Integer

'Variablen füllen

'Filesystemobjekt erstellen

Set fs = CreateObject("Scripting.FileSystemObject")

'Hier die Anzahl Empfänger definieren





'AnzEmpfänger = anzahl der empf in spalte b ermitteln

AnzEmpfänger = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row



'1. Fehlerprüfung

'Prüfen ob alle Inhalte vorhanden sind

'Wenn nicht wird das Makro abgebrochen

For i = 2 To AnzEmpfänger

If Cells(i, 2) = "" Or Cells(i, 3) = "" Or Cells(i, 4) = "" Then

Msg = MsgBox("Unvollständige Angaben beim Empfänger in Zeile " & i, vbCritical + vbOKOnly, "Abbruch")

Exit Sub

End If

Next i

'2. Fehlerprüfung

'Mit dem FilesystemObjekt wird zuerst die Existenz

'der Dateien geprüft. Wenn eine nicht existiert

'wird das Makro abgebrochen

'Die Links auf die Anlagen liegen im

'Bereich g2 : g10





'For y = 2 To 10

For y = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row



'Wenn eine Zelle leer ist, wird aus der Schleife ausgestiegen

'ohne weitere Fehlerprüfung

If Cells(y, 7) = "" Then Exit For

If fs.fileexists(Cells(y, 7)) = False Then

Msg = MsgBox("Die Datei: " & Cells(y, 6) & " in F" & y & " exitstiert nicht !" & vbCrLf & "Der Sendevorgang an; " & Cells(i, 1) & " wird abgebrochen!", vbCritical + vbOKOnly, "Dateifehler")

Exit Sub

End If

Next y

'Sendevorgang einleiten

For i = 2 To AnzEmpfänger

Set OutApp = CreateObject("Outlook.Application")

Set Nachricht = OutApp.CreateItem(0)

On Error GoTo next_email

With Nachricht

.To = Cells(i, 2) '"irgendwer@irgendein-provider.de"

.Subject = Cells(i, 3) '"Betreffzeile Header"

.Body = Cells(i, 4) '"Sendetext"



'For y = 2 To 11

For y = 2 To ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row



AWS = Cells(y, 7)

'Wenn die Zelle / Variable leer ist

'wird diese Schleife abgebrochen

If AWS = "" Then Exit For

.Attachments.Add AWS

Next y

'Hier wird die Mail zuerst angezeigt

'.Display

'Hier wird die Mail gleich in den Postausgang gelegt

.Send

End With

'Variablen zurücksetzen

Set OutApp = Nothing 'CreateObject("Outlook.Application")

Set Nachricht = Nothing 'OutApp.CreateItem(0)

Application.Wait (Now + TimeValue("0:00:02"))



'versanddatum /-uhrzeit /-userid und computername in spalte e eintragen

Worksheets(ActiveSheet.Name).Cells(i, 5).Value = Date & " / " & Time & _

" / " & Environ("username") & " " & Environ("computername")



next_email:



Next i



End Sub






Suche in meinen 22.000 Zitaten
mittels Volltextsuche ! HIER

Und hier in mein Excel-Tips

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: