E-Mails automatisch versenden

Sub Test() Dim objOutlook As Object Dim objMail As Object Dim i As Integer Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) For i = 3 To 100 With objMail .To = Cells(i, 3) .Subject = Range("G3") .body = Range("H3") .Display End With Next Set objOutlook = Nothing Set objMail = Nothing End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Philip,
ohne deine Datei angesehen zu haben.
Wenn du wirklich 297 Mails versenden willst, dann so.

Sub Test()
  Dim objOutlook As Object
  Dim objMail As Object
  Dim i As Integer

  Set objOutlook = CreateObject("Outlook.Application")

  For i = 3 To 300
    Set objMail = objOutlook.CreateItem(0)
    With objMail
      .To = Cells(i, 3)
      .Subject = Range("G3")
      .body = Range("H3")
      .Display
    End With
    Set objMail = Nothing
  Next

  Set objOutlook = Nothing
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Wenn du eine Mail an 297 Empfänger schicken willst, dann so.

Sub Test2()
  Dim objOutlook As Object
  Dim objMail As Object
  Dim varAddress As Variant, strTo As String

  Set objOutlook = CreateObject("Outlook.Application")
  
  varAddress = Range("C3:C100")
  strTo = Join(Application.Transpose(varAddress), ";")

  Set objMail = objOutlook.CreateItem(0)
  With objMail
    .To = strTo
    .Subject = Range("G3")
    .body = Range("H3")
    .Display
  End With
   

  Set objMail = Nothing
  Set objOutlook = Nothing
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

	A	B	C	D	E	F
1	Gruß Sepp
2
3

Sub Test() Dim objOutlook As Object, objMail As Object Dim rng As Range Set objOutlook = CreateObject("Outlook.Application") With ActiveSheet 'oder With Sheets("Tabellenname") For Each rng In .Range("C3:C" & Application.Max(3, .Cells(.Rows.Count, 3).End(xlUp).Row)) If Len(Trim(rng)) Then Set objMail = objOutlook.CreateItem(0) With objMail .To = Trim(rng) .Subject = .Range("G3") .body = .Range("H3") .Display 'oder '.Send End With Set objMail = Nothing End If Next End With Set objOutlook = Nothing End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Sub Test() Dim objOutlook As Object, objMail As Object Dim rng As Range, strSubject As String, strBody As String Set objOutlook = CreateObject("Outlook.Application") With ActiveSheet 'oder With Sheets("Tabellenname") strSubject = .Range("G3") strBody = .Range("H3") For Each rng In .Range("C3:C" & Application.Max(3, .Cells(.Rows.Count, 3).End(xlUp).Row)) If Len(Trim(rng)) Then Set objMail = objOutlook.CreateItem(0) With objMail .To = Trim(rng) .Subject = strSubject .body = strBody .Display 'oder '.Send End With Set objMail = Nothing End If Next End With Set objOutlook = Nothing End Sub VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0

Sub Auto_Mail() Dim objOutlook As Object, objMail As Object Dim rng As Range, strSubject As String, strBody As String Set objOutlook = CreateObject("Outlook.Application") With ActiveSheet 'oder With Sheets("Tabellenname") strSubject = Worksheets("Mail").Range("B2") strBody = Worksheets("Mail").Range("B4") For Each rng In .Range("F4:F" & Application.Max(3, .Cells(.Rows.Count, 3).End(xlUp).Row)) If Len(Trim(rng)) Then Set objMail = objOutlook.CreateItem(0) With objMail .GetInspector .To = Trim(rng) .Subject = strSubject .body = strBody & vbNewLine & .body .Attachments.Add "C:\Users\Christian Harzendorf\OneDrive\Arbeit\BIKAR\Konstruktion\ _ Anfrage.zip" '.Display .Send End With Set objMail = Nothing End If Next End With Set objOutlook = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

E-Mails automatisch versenden

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread