none
VBA to create Outlook message but how to make email window pop up to forefront? RRS feed

  • Question

  • I'm using this macro to create a prepopulated email from within Excel but I need to know what code to add (and where) so that the Outlook new email message window always pops up to the forefront. Thanks.

    Option Explicit
    Public wasOpen As Boolean
    Function StartApp(ByVal appName) As Object
    On Error GoTo ErrorHandler
    Dim oApp As Object

    wasOpen = True
    Set oApp = GetObject(, appName)    'Error here - Run-time error '429':
    Set StartApp = oApp

    Exit Function

    ErrorHandler:
    If Err.Number = 429 Then
        'App is not running; open app with CreateObject
        Set oApp = CreateObject(appName)
        wasOpen = False
        Resume Next
    Else
        MsgBox Err.Number & " " & Err.Description
    End If
    End Function


    Public Sub CreateAnEmail()
    Dim objOutlook As Outlook.Application
    Dim objOutlookMsg As Outlook.MailItem
    Dim objOutlookRecip As Outlook.Recipient
    Dim objOutlookAttach As Outlook.Attachment
    Dim objOutlookExplorers As Outlook.Explorers
    Dim ns As Outlook.Namespace
    Dim Folder As Outlook.MAPIFolder

    Set objOutlook = StartApp("Outlook.Application")
    Set ns = objOutlook.GetNamespace("MAPI")
    Set Folder = ns.GetDefaultFolder(olFolderInbox)
    Set objOutlookExplorers = objOutlook.Explorers

    If wasOpen = False Then
        objOutlookExplorers.Add Folder
        Folder.Display
        'done opening
    End If


    ' Create the message.
    Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

    With objOutlookMsg

        ' Add the To recipient(s) to the message.
        Set objOutlookRecip = .Recipients.Add(Sheets("InquiryPacketRequest").Range("A2").Value)
        objOutlookRecip.Type = olTo
      
        .Subject = Sheets("InquiryPacketRequest").Range("B2")

         .Body = .Body & Sheets("InquiryPacketRequest").Range("C1") & " " & Sheets("InquiryPacketRequest").Range("C2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("D1") & " " & Sheets("InquiryPacketRequest").Range("D2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("E1") & " " & Sheets("InquiryPacketRequest").Range("E2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("F1") & " " & Sheets("InquiryPacketRequest").Range("F2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("G1") & " " & Sheets("InquiryPacketRequest").Range("G2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("H1") & " " & Sheets("InquiryPacketRequest").Range("H2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("I1") & " " & Sheets("InquiryPacketRequest").Range("I2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("J1") & " " & Sheets("InquiryPacketRequest").Range("J2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("K1") & " " & Sheets("InquiryPacketRequest").Range("K2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("L1") & " " & Sheets("InquiryPacketRequest").Range("L2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("M1") & " " & Sheets("InquiryPacketRequest").Range("M2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("N1") & " " & Sheets("InquiryPacketRequest").Range("N2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("O1") & " " & Sheets("InquiryPacketRequest").Range("O2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("P1") & " " & Sheets("InquiryPacketRequest").Range("P2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("Q1") & " " & Sheets("InquiryPacketRequest").Range("Q2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("R1")
         .Body = .Body & Sheets("InquiryPacketRequest").Range("S1") & " " & Sheets("InquiryPacketRequest").Range("S2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("T1") & " " & Sheets("InquiryPacketRequest").Range("T2") & vbCrLf
         .Body = .Body & Sheets("InquiryPacketRequest").Range("U1") & " " & Sheets("InquiryPacketRequest").Range("U2") & vbCrLf
         .Display

    End With

    End Sub

    • Moved by George123345 Wednesday, December 10, 2014 8:35 AM
    Tuesday, December 9, 2014 11:21 PM

Answers

All replies