Outlook Sendmal Rückfrage immer im Vordergrund wie

Hallo zusammen
Ich habe ein Makro erstellt, welches über Sendmail eine Mail in Outlook versendet. Nun kommt ja bei Outlook dann jeweils die Warnmeldung. Das ist auch noch gut so, aber viele Anwender klicken anstelle auf diese Schalfläche 'JA' irgendwo im Bildschirm, dann hängt die Meldung im Hintergrund und die Anwender denken ... oje jetzt ist das Makro abgestürzt und beginnen wie wild zu klicken, beenden Excel über den Task-Manager oder schalten ihn sogar aus.
Kennt jemand von Euch eine Möglichkeit, wie man diese Meldung immer im Vordergrund halten kann? Das die Meldung an und für sich kommt, ist ok, denn ich habe eine Rückmeldung an das Makro wenn nein gedrückt wurde, wird die Ausführung abgebrochen.
Herzlichen Dank schon mal

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Brian,
dein Programm ist fertig. Das ganze ist in eine kleine .exe gepackt, die kurz vor dem senden der Mail aufgerufen wird. Wie der Aufruf erfolgt, entnimmst du der folgenden Testroutine. Den Pfad in der API - Funktion "ShellExecute" musst du natürlich noch anpassen.

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal lpnShowCmd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Sub test1()
    Dim myOutlookApplication As New Outlook.Application
    Dim myMail As Outlook.MailItem
    ShellExecute FindWindow("xlMain", vbNullString), "OPEN", "WindowPos.exe", "", "C:\Dokumente und Einstellungen\Administrator\Desktop\", 0
    Set myMail = myOutlookApplication.CreateItem(olMailItem)
    myMail.To = "x@y"
    myMail.CC = "y@x"
    myMail.Subject = "Neuer Dateneingang am " & Now
    myMail.HTMLBody = "Siehe Protokoll:  <a href=" & Chr(34) & "file:///" & ThisWorkbook.Name & Chr(34) & ">EINGANG-Protokoll</a>"
    On Error Resume Next
    myMail.Send
    MsgBox IIf(Err.Number = 0, "Erfolgreich", "Nicht") & " gesendet.", 48, "Hinweis"
End Sub

Das Programm der .exe beinhaltet folgenden Code:

Option Explicit
Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal wIndx As Long) As Long
Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const GW_HWNDFIRST = 0
Private Const GW_HWNDNEXT = 2
Private Const GWL_STYLE = -16
Private Const WS_VISIBLE = &H10000000
Private Const WS_BORDER = &H800000
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Public Sub Main()
    Dim hWnd As Long, sTitle As String, lStyle As Long, lngZeile As Long, intindex As Integer
    For intindex = 1 To 50
        hWnd = GetWindow(FindWindow(vbNullString, vbNullString), GW_HWNDFIRST)
        Do
            lStyle = GetWindowLong(hWnd, GWL_STYLE) And (WS_VISIBLE Or WS_BORDER)
            sTitle = GetWindowTitle(hWnd)
            If (lStyle = (WS_VISIBLE Or WS_BORDER)) = True And Trim(sTitle) = "Microsoft Outlook" Then
                SetWindowPos hWnd, -1, 0, 0, 0, 0, SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
                Exit Sub
            End If
            hWnd = GetWindow(hWnd, GW_HWNDNEXT)
        Loop Until hWnd = 0
        Sleep 100
    Next
End Sub
Private Function GetWindowTitle(ByVal hWnd As Long) As String
    Dim lResult As Long, sTemp As String
    lResult = GetWindowTextLength(hWnd) + 1
    sTemp = Space(lResult)
    lResult = GetWindowText(hWnd, sTemp, lResult)
    GetWindowTitle = Left(sTemp, Len(sTemp) - 1)
End Function

Hier der Link zum downloaden: https://www.herber.de/bbs/user/9012.zip
Das Programm läuft rund 5 Sekunden, bevor es sich selbst beendet. In dieser Zeit sollte es das Fenster gefunden und in den Vordergrund gesetzt haben.
Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Outlook Sendmal Rückfrage immer im Vordergrund wie

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

260 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Outlook Sendmal Rückfrage immer im Vordergrund wie

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

260 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread