Outlook Prüfen/Starten
29.03.2017 14:09:02
Schläfer
ich habe folgendes Problem:
Ich habe hier unten mein Makro aufgeführt, dass automatisch Mails an entsprechende Email-Gruppen verteilt.
Nun brauche ich eine Ergänzung die prüft, ob Microsoft Outlook geöffnet ist
-> wenn ja dann das untenstehende Makro ausführen
-> wenn nein dann, Outlook starten und danach Makro ausführen
Ich weiß das das Makro auch so funktionieren würde nur muss in meinem Fall zwingend diese Prü _ fung stattfinden muss, bzw. Outlook separat gestartet werden.
Sub Mail_Erinnerung()
Application.ScreenUpdating = False
Dim Alk1 As String
Dim Alk2 As String
Dim Alk3 As String
Dim Alk4 As String
Dim Zelle As Range
For Each Zelle In Range("C4:C20")
If Zelle.Interior.ColorIndex = 19 Then
Zelle.Interior.ColorIndex = 20
Zelle.Offset(0, -1).Select
Select Case ActiveCell.Value
Case Is = "Alk 1"
Alk1 = "zzINGAlkaloide6@XX.com"
Case Is = "Alk 2"
Alk2 = "christoph@XX.com"
Case Is = "Alk 3"
Alk3 = "oleg@XX.com
Case Is = "Alk 4"
Alk4 = "marco@XX.com
End Select
End If
Next
Set olAppication = CreateObject("Outlook.Application")
Set objEMail = olAppication.CreateItem(olMailItem)
Application.Wait Now + TimeSerial(0, 0, 5)
With objEMail
.To = "Verteiler@XX.com"
.cc = Alk1 & ";" & Alk2 & ";" & Alk3 & ";" & Alk4
.Subject = "Bestellung"
.Body = "Hallo zusammen," & vbLf & vbLf & "eine Bestellung wurde aufgegeben." & _
vbLf & vbLf & "Link:" & vbLf & "file:\\XYZ
.display
.Send
End With
Set objEMail = Nothing
Application.ScreenUpdating = True
ActiveWorkbook.Close SaveChanges:=True
End Sub
Anzeige