Late Binding

[jeremyjohnolson]

Does anyone know how to change the below code to late binding as to not have to have a user enable the Outlook object library reference?

Sub Download_Outlook_Mail_To_Excel3()
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim WksName As String
    WksName = "Macro" '****name of worksheet to put data****


    Dim appOutlook As Outlook.Application
    Dim nms As Outlook.Namespace
    Dim Folder As Outlook.MAPIFolder
    Dim iRow As Integer
    Dim oRow As Integer
    Dim nEmails As Integer
    Dim nConvos As Integer
    
    Set appOutlook = GetObject(, "Outlook.Application")
    Set nms = appOutlook.GetNamespace("MAPI")
    Set Folder = nms.PickFolder
        
    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"
    
    'Clear old data
    Worksheets(WksName).Cells(1, 1).EntireColumn.Clear
    
    'Insert Column Headers
    Worksheets(WksName).Cells(1, 1) = "Conversation Topics:"
    
    'Insert Mail Data
    For iRow = 1 To Folder.Items.Count
        oRow = iRow + 1
        Worksheets(WksName).Cells(oRow, 1) = Folder.Items.Item(iRow).ConversationTopic
    Next iRow
    
    'put number of emails on sheet
    nEmails = Worksheets(WksName).Cells(1, 1).EntireColumn.Cells.SpecialCells(xlCellTypeConstants).Count - 1
    Worksheets(WksName).Cells(2, 3).Value = nEmails
    
    'Remove duplicates
    Worksheets(WksName).Cells(1, 1).EntireColumn.RemoveDuplicates Columns:=1, Header:=xlYes
    
    'put number of conversations on sheet
    nConvos = Worksheets(WksName).Cells(1, 1).EntireColumn.Cells.SpecialCells(xlCellTypeConstants).Count - 1
    Worksheets(WksName).Cells(2, 4).Value = nConvos
    
    'Formatting & hide tab
    Worksheets(WksName).Cells(1, 1).EntireColumn.AutoFit
    Worksheets(WksName).Cells(1, 1).Font.Underline = xlUnderlineStyleSingle
    Worksheets(WksName).Visible = True
'    Worksheets(WksName).Visible = xlSheetVeryHidden
    
    MsgBox "Outlook Mails Extracted to Excel"
 
JumpExit:
    Set nms = Nothing
    Set Folder = Nothing
    Exit Sub


End Sub

 

[iliace]

Change these variables to be of Object type:

    Dim appOutlook As Outlook.Application
    Dim nms As Outlook.Namespace
    Dim Folder As Outlook.MAPIFolder

Instead do this:

    Dim appOutlook As Object    ' Outlook.Application
    Dim nms As Object           ' Outlook.Namespace
    Dim Folder As Object        ' Outlook.MAPIFolder

You will also need to hard-code the enumerations. You can get the values from the help file, or using the Immediate window Debug.Print. For example, this line:

    ElseIf Folder.DefaultItemType <> olMailItem Then

becomes this:

    ElseIf Folder.DefaultItemType <> 0 Then    ' OlItemType.olMailItem = 0

I strongly recommend you use comments (in green above) to keep track of what library object each variable actually represents. Makes your life a lot easier when modifying, troubleshooting, or debugging later on.

 

[jeremyjohnolson]

Thank you so much, this is awesome! You are a tremendous help...I will test it out later and let you know if I have any questions.

 

[jeremyjohnolson]

It works! Thank you. Here is the new code

Option Explicit

Sub EmailConvos(control As IRibbonControl)
   
   Application.ScreenUpdating = False
    
    'Add Tools->References->"Microsoft Outlook nn.n Object Library"
    'nn.n varies as per our Outlook Installation
    Dim WksName As String
    WksName = "Macro" '****name of worksheet to put data****


    Dim DestCell As Range
    Dim appOutlook As Object 'Outlook.Application
    Dim nms As Object 'Outlook.Namespace
    Dim Folder As Object 'Outlook.MAPIFolder
    Dim EndDate As Date
    Dim BegDate As Date
    Dim iTims As Object 'Outlook.Items
    Dim iRow As Integer
    Dim oRow As Integer
    Dim nEmails As Integer
    Dim nConvos As Integer
    
    On Error Resume Next
    Set DestCell = Application.InputBox(Prompt:="Please use mouse to select destination cell.", _
        Title:="Destination Cell", Default:=ActiveCell.Address, Type:=8)
    On Error GoTo 0
    If DestCell Is Nothing Then
        Exit Sub
    Else
        Set appOutlook = GetObject(, "Outlook.Application")
        Set nms = appOutlook.GetNamespace("MAPI")
        Set Folder = nms.PickFolder
        EndDate = ActiveSheet.Range("EndDate").Value + 1
        BegDate = EndDate - 6
        Set iTims = Folder.Items.Restrict("[SentOn] > '" & BegDate & "' And [SentOn]<'" & EndDate & "'")
            
        'Make screen go back to showing Excel after picking Outlook folder
        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 <> 0 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"
        
        'Clear old data
        Worksheets(WksName).Cells(1, 1).EntireColumn.Clear
        Worksheets(WksName).Cells(1, 2).EntireColumn.Clear
        
        'Insert Column Headers
        Worksheets(WksName).Cells(1, 1) = "Conversation Topics:"
        Worksheets(WksName).Cells(1, 2) = "Sent Date:"
        
        'Insert Mail Data
        For iRow = 1 To iTims.Count
            oRow = iRow + 1
            Worksheets(WksName).Cells(oRow, 2) = iTims.Item(iRow).SentOn
            Worksheets(WksName).Cells(oRow, 1) = iTims.Item(iRow).ConversationTopic
        Next iRow
        
        'Put EndDate and BegDate on sheet
        Worksheets(WksName).Cells(5, 4).Value = BegDate
        Worksheets(WksName).Cells(5, 5).Value = EndDate
        
        'put number of emails on sheet
        nEmails = Worksheets(WksName).Cells(1, 1).EntireColumn.Cells.SpecialCells(xlCellTypeConstants).Count - 1
        Worksheets(WksName).Cells(2, 4).Value = nEmails
        
        'Remove duplicates
        Worksheets(WksName).Range("A:B").RemoveDuplicates Columns:=1, Header:=xlYes
        
        'put number of conversations on sheet
        nConvos = Worksheets(WksName).Cells(1, 1).EntireColumn.Cells.SpecialCells(xlCellTypeConstants).Count - 1
        Worksheets(WksName).Cells(2, 5).Value = nConvos
        DestCell.Value = nConvos
        
        'Formatting & hide tab
        Worksheets(WksName).Cells(1, 1).Font.Underline = xlUnderlineStyleSingle
        Worksheets(WksName).Cells(1, 2).Font.Underline = xlUnderlineStyleSingle
        Worksheets(WksName).Range("A:E").EntireColumn.AutoFit
'        Worksheets(WksName).Visible = True
        Worksheets(WksName).Visible = xlSheetVeryHidden
        Application.ScreenUpdating = True
    End If
 
JumpExit:
    Set nms = Nothing
    Set Folder = Nothing
    Application.ScreenUpdating = True
    Exit Sub


End Sub

 

[jeremyjohnolson]

So this is a little odd, I finished the macro which is saved in the workbook that is saved on my company's network drive...when I go to open the workbook on another computer I see the iribbon button but it will not execute the macro. It even shows up in VBE but won't execute???

 

[jeremyjohnolson]

I think it has something to do with my digital signature...

 

[iliace]

I recently had a very similar issue. Try going to Excel Options -> Add-ins. At the bottom of the window, in the Manage drop-down, choose Disabled Items and press Go. See if your workbook is on that list.

 

[jeremyjohnolson]

I think I need to add my certificate to the trusted certs of my buddies computer for it to work on his. I will try this tomorrow when he is back in.