Hilfe bei Schleife für Email
07.07.2013 20:56:49
Karl-Ludwig
ich habe mal wieder ein kleines Problem :-/
Mittels Autofilter grenze ich den Datumsbereich ein (Tab Gesamt, Spalte K)- in Spalte A ist der Auftragsnehmer
In einem anderen Tabellenblatt (Dienstleister) habe ich die Firma in der Spalte A, die Mailadresse zu der Fa. in Spalte B und in Spalte C prüfe ich mit folgender Formel, ob der Filter Daten für den Dienstleister enthält:
=SUMMENPRODUKT(TEILERGEBNIS(3;INDIREKT("Gesamt!$A"&ZEILE($9:$5999)))*(Gesamt!$A$9:$A$5999=A2))
Spalte D prüft, ob eine Mailadresse hinterlegt ist und Aufträge vorhanden sind:
=WENN(ODER(B2="";C2=0)=FALSCH;"Ja";"Nein")
Soweit ist alles OK.
Folgender Code funktioniert grundsätzlich- Allerdings soll nur dann eine Mail generiert werden, wenn die gefilterte Liste (d.h. der Dienstleister in dem eingangs gefilterten Datumsberich Sheets("gesamt").Range("K) keinen Transport durchzuführen hat)nicht leer ist. Im Moment nbekomme ich eine Mail für jeden angelegten Dienstleister- ob der beauftragt werden soll oder nicht.
Sub Transportaufträge_senden()
If MsgBox("Transportaufträge versenden?", vbOKCancel, "Transporte 2012") = vbOK Then
' On Error GoTo fehler
' Application.DisplayAlerts = False
' Application.ScreenUpdating = False
Dim Startdatum As String, Enddatum As String
Dim loLetzte As Long
Dim lngZeile As Long
Dim strFilter As String
Dim rng As Range
Dim olapp As Object
Dim strBody As String
Dim strKW As String
Dim strMailadr As String
Dim strCC_1 As String
Dim strCC_2 As String
ActiveWorkbook.Worksheets("Gesamt").Activate
Startdatum = CStr(CLng(Range("$I$6").Value))
Enddatum = CStr(CLng(Range("$K$6").Value))
strKW = Worksheets("Gesamt").Range("H6")
strCC_1 = Worksheets("Dienstleister").Range("G1")
strCC_2 = Worksheets("Dienstleister").Range("G2")
ActiveWorkbook.Worksheets("Gesamt").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Gesamt").AutoFilter.Sort.SortFields.Add Key:=Range _
("K8:K65536"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Gesamt").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Gesamt").Range("$A$8:$Z$65536").CurrentRegion.AutoFilter Field:= _
_
11, Criteria1:= _
">=" & Startdatum, Operator:=xlAnd, Criteria2:=" "" Then
strFilter = Range("A" & lngZeile).Value
strMailadr = Range("b" & lngZeile).Value
ActiveWorkbook.Sheets("Gesamt").Activate
ActiveSheet.Range("$A$8:$Z$65536").CurrentRegion.AutoFilter Field:=1, Criteria1: _
_
=strFilter
loLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp). _
Row, Rows.Count)
Range("B8:R" & loLetzte).Select
Set olapp = CreateObject("Outlook.Application")
With olapp.CreateItem(0)
Set rng = Selection
.To = strMailadr
.cc = strCC_1 & "; " & strCC_2 'optional Kopie an
.HtmlBody = "" & _
"Sehr geehrte Damen und Herren" & ",
" & _
"folgende Transporte für die Kalenderwoche " & strKW & "
" & _
' weiteren Text ausgeschnitten
.ReadReceiptRequested = True ' optional Lesbestätigung anfordern
.Subject = "Transporte KW " & strKW
' .display
End With
Set rng = Nothing
Set olapp = Nothing
ActiveWorkbook.Sheets("Dienstleister").Activate
MsgBox strFilter & " " & strMailadr & " " & lngZeile 'nur zum testen
'Else
End If
Next
ActiveWorkbook.Sheets("Gesamt").Activate
Columns("N:Q").Hidden = False
Columns("F").Hidden = False
Call Autofilter_entf
End If
Exit Sub
fehler:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Columns("N:Q").Hidden = False
Columns("F").Hidden = False
Call Autofilter_entf
MsgBox "Fehler im Modul Versandplan versenden"
End Sub
Wie bekomme ich das hin, dass nur dann eine Mail generiert wird, wenn ind der Spalte D der Tabelle Dienstleister ein "JA" steht?
So hab ich es schon versucht- das wäre aber zu einfach gewesen :-):
If Range("A" & lngZeile) "" And Range("D" & lngZeile) = "Ja" Then
hat jemand eine Idee und kann und will mir helfen?
Vielen Dank vorab+ Viele Grüße
KL