Wie kann ich automatisch die benötigte Anzahl für "to x" ermitteln, wenn die Anzahl Datensätze ständig variert?
Gruss
Frédéric
Option Explicit
Sub tst()
Dim lngL As Long, ii As Long
With Sheets("Tabelle1")
lngL = .Cells(.Rows.Count, 4).End(xlUp).Row ' letzte in Sp.4 (D) belegte Zeile
For ii = 1 To lngL
' ... dein Code
Next ii
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-LintfortSub ()
Dim olApp As Object
Dim wsShell
Dim iCounter As Long
If MsgBox("Soll der automatische E-Mail Versand gestartet werden?", _
vbYesNo + vbQuestion, "Frage") = vbNo Then Exit Sub
For iCounter = 1 To 2
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
Sheets("Selektionsliste").Select
.To = Cells(iCounter, 1)
.Subject = Cells(iCounter, 12)
.Body = Cells(iCounter, 14) & vbCrLf & vbCrLf & _
Cells(iCounter, 15) & vbCrLf & _
Cells(iCounter, 16) & vbCrLf & vbCrLf & _
Cells(iCounter, 17) & vbCrLf & vbCrLf & _
Cells(iCounter, 18) & vbCrLf
.Display
Set wsShell = CreateObject("WScript.Shell")
wsShell.AppActivate olApp
wsShell.SendKeys "%s"
Set wsShell = Nothing
Application.Wait (Now + TimeValue("0:00:05"))
End With
Next iCounter
Set olApp = Nothing
MsgBox "Der E-Mail Versand ist abgeschlossen"
End Sub
Sub LeereZeilenLöschen()
Dim i As Long
Dim rng As Object
Dim lEmpty As Boolean
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
lEmpty = True
For Each rng In ActiveSheet.Rows(i).Cells
'sind alle Zelle leer ?
If rng.Value > "" Then
lEmpty = False
Exit For
End If
Next
If lEmpty = True Then
ActiveSheet.Rows(i).Delete
End If
Next i
End Sub
Die Anzahl der Mail-Empfänger variert ständig. Deshalb muss ich derzeit die Anzahl zu durchlaufenden Zeilen immer manuell im Code anpassen. Kann ich die korrekte Anzahl der gefüllten Zeilen (durch Code 2 eruiert) irgendwie in Code 1 übernehmen?
Sub Test2()
Dim olApp As Application ' war Object
Dim wsShell As Object ' war ohne Typ, also Variant
Dim iCounter As Long
If MsgBox("Soll der automatische E-Mail Versand gestartet werden?", _
vbYesNo + vbQuestion, "Frage") = vbNo Then Exit Sub
Sheets("Selektionsliste").Select ' Anweisung kam später
For iCounter = 1 To Cells(Rows.Count, 1).End(xlUp).Row ' war "To 2"
Set olApp = CreateObject("Outlook.Application")
With olApp.CreateItem(0)
.To = Cells(iCounter, 1)
.Subject = Cells(iCounter, 12)
.Body = Cells(iCounter, 14) & vbCrLf & vbCrLf & _
Cells(iCounter, 15) & vbCrLf & _
Cells(iCounter, 16) & vbCrLf & vbCrLf & _
Cells(iCounter, 17) & vbCrLf & vbCrLf & _
Cells(iCounter, 18) & vbCrLf
.Display
Set wsShell = CreateObject("WScript.Shell")
wsShell.AppActivate olApp
wsShell.SendKeys "%s"
Set wsShell = Nothing
Application.Wait Now + TimeValue("0:00:05")
End With
Next iCounter
Set olApp = Nothing
MsgBox "Der E-Mail Versand ist abgeschlossen"
End Sub
@Micha:
Option Explicit
Sub Test2()
Dim olApp As Object
Dim wsShell As Object ' war ohne Typ, also Variant
Dim iCounter As Long
If MsgBox("Soll der automatische E-Mail Versand gestartet werden?", _
vbYesNo + vbQuestion, "Frage") = vbNo Then Exit Sub
Sheets("Selektionsliste").Select ' Anweisung kam später
Set olApp = CreateObject("Outlook.Application") ' Anweisung kam später
For iCounter = 1 To Cells(Rows.Count, 1).End(xlUp).Row ' war "To 2"
With olApp.CreateItem(0)
.To = Cells(iCounter, 1)
.Subject = Cells(iCounter, 12)
.Body = Cells(iCounter, 14) & vbCrLf & vbCrLf & _
Cells(iCounter, 15) & vbCrLf & _
Cells(iCounter, 16) & vbCrLf & vbCrLf & _
Cells(iCounter, 17) & vbCrLf & vbCrLf & _
Cells(iCounter, 18) & vbCrLf
.Display
Set wsShell = CreateObject("WScript.Shell")
wsShell.AppActivate olApp
wsShell.SendKeys "%s"
Set wsShell = Nothing
Application.Wait Now + TimeValue("0:00:05")
End With
Next iCounter
Set olApp = Nothing
MsgBox "Der E-Mail Versand ist abgeschlossen"
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort