title image


Smiley Schön dass der Code noch funktioniert :-))
Hallo Stefan,



... der ist ja noch von mir,... oder ?





Sub Segment()

For i = 2 To AnzEmpfänger

Set OutApp = CreateObject("Outlook.Application")

Set Nachricht = OutApp.CreateItem(0)

On Error GoTo next_email

'NEU

'----------

'Hier wird die zelle i in Spalte A

'auf den Wert X geprüft

'UCASE deshalb um Schreibfehler von Gross und

'klein zu vermeiden

If UCase(Cells(i, 1).Value) = "X" Then

    'Trifft die Bedingung X zu wird

    'der Mailversand eingeleitet

    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:

End If

'Bedingung abgeschlossen

Next i

End Sub Code eingefügt mit Syntaxhighlighter 1.16


Herzliche Grüsse

aus der Schweiz

Rainer

Kombiniere Geist und Google,...denn Wissen ist geil :-)



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: