Ich hab diesen Code umgeschrieben das er in meiner Excel Tabelle die markierten Reihe zu einer E-mail macht!
Jetzt würde ich nur noch gern machen das wenn in einer Reihe keine Email drin steht das auch keine Mail generiert wird…kann mir da jemande helfen?
Sub Excel_Serial_MailV2()
Dim MyOutApp As Object, MyMessage As Object
Dim Zelle As Range, src As Range
’ Schnittmenge aus allen selektierten Zellen und Spalte A
Set src = Intersect(Selection, Columns(1))
If src Is Nothing Then Exit Sub
Set MyOutApp = CreateObject(„Outlook.Application“)
'Start der Sendeschleife an alle in der Spalte A markierten Empfänger
For Each Zelle In src
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Die Empfänger stehen in Spalte A ab Zeile 1
.To = Zelle.Offset(0, 11) 'E-Mail Adresse
'.cc = Zelle.Offset(0, 8)
'Der Betreff in Spalte B
.Subject = Zelle.Offset(0, 13) '„Betreffzeile“
'Der zu sendende Text in Spalte C
'Maximal 1024 Zeichen
'Der Text wird ohne Formatierung übernommen
.Body = Zelle.Offset(0, 12) '„Text“
'Hier wird die Mail angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
’ und als gesendet markieren in Spalte D
Zelle.Offset(0, 14).Value = Now
End With
'Objectvariablen leeren
Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
'Sendepause einschalten
'Outlook kann die Aufträge nicht schnell genug verarbeiten
Application.Wait (Now + TimeValue(„0:00:07“))
Next Zelle
Set MyOutApp = Nothing 'CreateObject(„Outlook.Application“)
End Sub
Ich hab diesen Code umgeschrieben das er in meiner Excel
Tabelle die markierten Reihe zu einer E-mail macht!
Jetzt würde ich nur noch gern machen das wenn in einer Reihe
keine Email drin steht das auch keine Mail generiert
wird…kann mir da jemande helfen?
Sub Excel_Serial_MailV2()
Dim MyOutApp As Object, MyMessage As Object
Dim Zelle As Range, src As Range
’ Schnittmenge aus allen selektierten Zellen und Spalte A
Set src = Intersect(Selection, Columns(1))
If src Is Nothing Then Exit Sub
Set MyOutApp = CreateObject(„Outlook.Application“)
'Start der Sendeschleife an alle in der Spalte A markierten
Empfänger
For Each Zelle In src
'#hier ein kriterium einfügen!
'if (welcheZelle „“) then
if (Zelle.Offset(0, 11).Value „“) then
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Die Empfänger stehen in Spalte A ab Zeile 1
.To = Zelle.Offset(0, 11) 'E-Mail Adresse
'.cc = Zelle.Offset(0, 8)
'Der Betreff in Spalte B
.Subject = Zelle.Offset(0, 13) '„Betreffzeile“
'Der zu sendende Text in Spalte C
'Maximal 1024 Zeichen
'Der Text wird ohne Formatierung übernommen
.Body = Zelle.Offset(0, 12) '„Text“
'Hier wird die Mail angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
’ und als gesendet markieren in Spalte D
Zelle.Offset(0, 14).Value = Now
End With
'Objectvariablen leeren
Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
'Sendepause einschalten
'Outlook kann die Aufträge nicht schnell genug
verarbeiten
Application.Wait (Now + TimeValue(„0:00:07“))
end if
Next Zelle
Set MyOutApp = Nothing 'CreateObject(„Outlook.Application“)
End Sub
Hoffe das klappt mit dem Zelle.Offset(0, 11). Hab das noch nie genutzt.
mfg
Dirk.Pagasus
Ich hab diesen Code umgeschrieben das er in meiner Excel
Tabelle die markierten Reihe zu einer E-mail macht!
Jetzt würde ich nur noch gern machen das wenn in einer Reihe
keine Email drin steht das auch keine Mail generiert
wird…kann mir da jemande helfen?
Hi Christian,
ungetestet:
Sub Excel\_Serial\_MailV2()
Dim MyOutApp As Object, MyMessage As Object
Dim Zelle As Range, src As Range
' Schnittmenge aus allen selektierten Zellen und Spalte A
Set src = Intersect(Selection, Columns(1))
If src Is Nothing Then Exit Sub
Set MyOutApp = CreateObject("Outlook.Application")
'Start der Sendeschleife an alle in der Spalte A markierten Empfänger
For Each Zelle In src
**If Zelle.Offset(0, 11) = "" Then GoTo Weiter**
Set MyMessage = MyOutApp.CreateItem(0)
With MyMessage
'Die Empfänger stehen in Spalte A ab Zeile 1
.To = Zelle.Offset(0, 11) 'E-Mail Adresse
'.cc = Zelle.Offset(0, 8)
'Der Betreff in Spalte B
.Subject = Zelle.Offset(0, 13) '"Betreffzeile"
'Der zu sendende Text in Spalte C
'Maximal 1024 Zeichen
'Der Text wird ohne Formatierung übernommen
.Body = Zelle.Offset(0, 12) '"Text"
'Hier wird die Mail angezeigt
.Display
'Hier wird die Mail gleich in den Postausgang gelegt
'.Send
' und als gesendet markieren in Spalte D
Zelle.Offset(0, 14).Value = Now
End With
'Objectvariablen leeren
Set MyMessage = Nothing 'MyOutApp.CreateItem(0)
'Sendepause einschalten
'Outlook kann die Aufträge nicht schnell genug verarbeiten
Application.Wait (Now + TimeValue("0:00:07"))
**Weiter:**
Next Zelle
Set MyOutApp = Nothing 'CreateObject("Outlook.Application")
End Sub
Gruß
Reinhard
Hey Reinhard
Danke danke danke! Hat geklappt musste nur noch meine auch dazufügen weil ich die Zelle ja trotzdem brauche.
If Zelle.Offset(0, 11) = „“ Then GoTo Weiter
.To = Zelle.Offset(0, 11) 'E-Mail Adresse
Auch danke an dich Pegasus!