Sub EMail_versenden()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim body As String
Dim SigString As String
Dim Signatur As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
SigString = Environ("appdata") & _
"\Microsoft\Signatures\Flo.htm"
If Dir(SigString) <> "" Then
Signatur = GetSig(SigString)
Else
Signatur = ""
End If
On Error GoTo cleanup
For Each cell In Columns("M").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "I").Value) > 3 And _
LCase(Cells(cell.Row, "H").Value) > 50 And _
LCase(Cells(cell.Row, "O").Value) <> "email wurde versendet" Then
On Error Resume Next
body = "<font face=Arial>" & "Hallo " & Cells(cell.Row, "N").Value & ",<br><br>" & _
"wegen folgendem Teil wurde zu oft ein GW-Antrag gestellt: <br><br>" & _
"<font color=blue>" & Cells(cell.Row, "C").Value & "</font> " & _
"<font color=green>" & Cells(cell.Row, "D").Value & "</font><br><br>" & _
"Mit der Bitte um schnelle Antwort.<br><br>" & _
"Mit freundlichen Grüßen<br>" & _
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = cell.Value
.Subject = "EWIR"
.HTMLBody = body & "<br><br>" & Signatur
.Display
End With
Cells(cell.Row, "O").Value = "email wurde versendet"
Cells(cell.Row, "O").Interior.ColorIndex = 4
Cells(cell.Row, "O").HorizontalAlignment = xlCenter
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
MsgBox "E-Mails wurden versendet!"
End Sub
Function GetSig(ByVal sFile As String) As String
Dim x As Object
Dim i As Object
Set x = CreateObject("Scripting.FileSystemObject")
Set i = x.GetFile(sFile).OpenAsTextStream(1, -2)
GetSig = i.ReadAll
i.Close
End Function