Activate Excel

[jeremyjohnolson]

I have the following code that is in Excel VBA. It gets emails conversation topics from emails in Outlook and pastes them into Excel. Everything works fine, except right after the line "Set Folder = nms.PickFolder" the screen displays Outlook and I want it to come back to the Excel file afterwards. So after Outlook is displayed on screen, what code do I need to put in my VBA macro to make it go back to showing Excel?

Option Explicit

Sub Download_Outlook_Mail_To_Excel2()
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim appOutlook As Outlook.Application
    Dim nms As Outlook.Namespace
    Dim Folder As Outlook.MAPIFolder
    Dim iRow As Integer
    Dim oRow As Integer
    Dim EndSel As Range
    


    Set appOutlook = GetObject(, "Outlook.Application")
    Set EndSel = Selection
    Set nms = appOutlook.GetNamespace("MAPI")
 
    Set Folder = nms.PickFolder


    'Handle potential errors with Select Folder dialog box.
    If Folder Is Nothing Then
         MsgBox "There are no mail messages to export", vbOKOnly, "Error"
         GoTo JumpExit
     ElseIf Folder.DefaultItemType <> olMailItem Then
         MsgBox "These are not Mail Items", vbOKOnly, "Error"
         GoTo JumpExit
     ElseIf Folder.Items.Count = 0 Then
         MsgBox "There are no mail messages to export", vbOKOnly, "Error"
         GoTo JumpExit
     End If
 
    'Read Through each Mail and export the details to Excel for Email Archival
    Folder.Items.Sort "Received"
    
    'Insert Column Headers
    Worksheets("test").Cells(1, 1) = "Conversation Topic"
    
    'Insert Mail Data
    For iRow = 1 To Folder.Items.Count
        oRow = iRow + 1
        Worksheets("test").Cells(oRow, 1).Select
        Worksheets("test").Cells(oRow, 1) = Folder.Items.Item(iRow).ConversationTopic
    Next iRow
    
    EndSel.Select
    
    MsgBox "Outlook Mails Extracted to Excel"


 
JumpExit:
    Set nms = Nothing
    Set Folder = Nothing
    Exit Sub


End Sub

 

[shg]

See the AppActivate statement.

 

[jeremyjohnolson]

Thanks shg. It took a bit of poking around, but I got it to work with this:

AppActivate ActiveWorkbook.Name

So this is what the code looks like now:

Option Explicit

Sub Download_Outlook_Mail_To_Excel2()
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim appOutlook As Outlook.Application
    Dim nms As Outlook.Namespace
    Dim Folder As Outlook.MAPIFolder
    Dim EndSel As Range
    Dim iRow As Integer
    Dim oRow As Integer
    
    Set appOutlook = GetObject(, "Outlook.Application")
    Set nms = appOutlook.GetNamespace("MAPI")
    Set Folder = nms.PickFolder
    Set EndSel = Selection
    
    AppActivate ActiveWorkbook.Name


    'Handle potential errors with Select Folder dialog box.
    If Folder Is Nothing Then
        MsgBox "There are no mail messages to export", vbOKOnly, "Error"
        GoTo JumpExit
    ElseIf Folder.DefaultItemType <> olMailItem Then
        MsgBox "These are not Mail Items", vbOKOnly, "Error"
        GoTo JumpExit
    ElseIf Folder.Items.Count = 0 Then
        MsgBox "There are no mail messages to export", vbOKOnly, "Error"
        GoTo JumpExit
    End If


    'Read Through each Mail and export the details to Excel for Email Archival
    Folder.Items.Sort "Received"
    
    'Insert Column Headers
    Worksheets("test").Cells(1, 1) = "Conversation Topic"
    
    'Insert Mail Data
    For iRow = 1 To Folder.Items.Count
        oRow = iRow + 1
        Worksheets("test").Cells(oRow, 1).Select
        Worksheets("test").Cells(oRow, 1) = Folder.Items.Item(iRow).ConversationTopic
    Next iRow
    
    EndSel.Select
    
    MsgBox "Outlook Mails Extracted to Excel"


 
JumpExit:
    Set nms = Nothing
    Set Folder = Nothing
    Exit Sub


End Sub

 

[shg]

Good job, you're welcome.