AW: Mit VBA Mail Antworten auf dem PC speichern und senden
Gast
Hallo Uwe
Sorry, ich habe keine Ahnung was Klient und POP3 ist?? Das sind für mich Böhmische Dörfer!
Ich benutze Forum-xxxxxx@hotmail.com (MS) und Privat ein ganz normales GMail Konto.
Mit normalen Grundeinstellungen, die ich selbst nie verändert habe. Kenne sie auch nicht.
Den Code s.u. aus dem Internet habe ich auf Mails mit Anhang automatisch senden umgestrickt.
Das klappt auch, aber bei -jedem senden- verlangt der Code das Forum Passwort. Das ist stressig!
Könnte man an der Stelle das Passwort festlegen?? --> Set MyMessage = MyOutApp.CreateItem(0) 'Passwort ???
Oder gibt es einen besseren Codes um zum Geburtstag viele Mails zu verschicken??
mfg Gast
Option Explicit
'Code aus Tabelle1
Sub Emails_Auto_versenden()
Dim EPfad As String
Dim EMail As String
Dim Datei1 As String
Dim Datei2 As String
Dim Datei3 As String
Dim Datei4 As String
Dim Body As String
Dim Inhalt As String
Dim Betreff As String
Dim Gesendet As String
Dim Lieferant As String
Dim EMAdr As Worksheet
Dim EMIni As Worksheet
Dim EMAtt As Worksheet
Dim Zeile As Long, f, n
Dim ok As Variant
Dim MyOutApp As Object
Dim MyMessage As Object
'*** Init-Bereich *************************
Set EMAdr = Worksheets("E-Mail Adr")
Set EMIni = Worksheets("M-Initial")
Set EMAtt = Worksheets("Anhang")
EMAdr.Range("C2:E1000,E1:F2").ClearContents
EMAdr.Range("C2:E1000").Font.ColorIndex = xlAutomatic
EPfad = ThisWorkbook.Path: n = 0
If Right(EPfad, 1) <> "\" Then EPfad = EPfad & "\"
Zeile = 2 '2=1.Zeile für E-Mail Adressen
'******************************************
Datei1 = Trim(EMAtt.Cells(2, 2))
Datei2 = Trim(EMAtt.Cells(3, 2))
Datei3 = Trim(EMAtt.Cells(4, 2))
Datei4 = Trim(EMAtt.Cells(5, 2))
If Datei1 = "" Then MsgBox EMail & " - kein Datei Anhang gefunden!": Exit Sub
EMAdr.[f1,f2] = Time
On Error Resume Next
Do While EMAdr.Cells(Zeile, 1) <> Empty
Gesendet = EMAdr.Cells(Zeile, 4): Err.Clear
If EMAdr.Cells(Zeile, 3) & Gesendet = "" Then
'** Grunddaten für die Email-Generierung
EMail = EMAdr.Cells(Zeile, 2)
Body = EMIni.Cells(4, 2)
Betreff = EMIni.Cells(3, 2)
'***************************
'Nur eine Email mit Datei generieren
'*** Outlook-Objket erstellen
Set MyOutApp = CreateObject("Outlook.Application")
Set MyMessage = MyOutApp.CreateItem(0) 'Passwort ???
With MyMessage
If Datei1 <> "" Then .Attachments.Add EPfad & Datei1
If Datei2 <> "" Then .Attachments.Add EPfad & Datei2
If Datei3 <> "" Then .Attachments.Add EPfad & Datei3
If Datei4 <> "" Then .Attachments.Add EPfad & Datei4
.To = EMail
.Subject = Betreff
.Body = Body
.Importance = 2 'Priorität 2 = Hoch
'Auto Mail aktiv - Senden
If EMAdr.Range("G2") <> "Ja" Then
.Display 'Email anzeigen vor dem Senden
EMAdr.Cells(Zeile, 3).Value = "Hand"
Else
'MsgBox EMail
.Send 'Hier wird die Mail gesendet
If Err.Number = 0 Then
EMAdr.Cells(Zeile, 3).Value = Now: n = n + 1
Else
f = f + 1
EMAdr.Cells(Zeile, 4).Value = "Error"
EMAdr.Cells(Zeile, 4).Font.ColorIndex = 3
End If
End If
End With
End If
Zeile = Zeile + 1
If EMAdr.Range("G2") = Empty Then Exit Do
Loop
If n > 0 Then EMAdr.[e1] = n & " Send"
If f > 0 Then EMAdr.[e2] = f & " Error"
EMAdr.[f2] = Time
End Sub