Late Binding

jeremyjohnolson

Board Regular
Joined
Apr 29, 2014
Messages
53
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?

Code:
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

Well-known Member
Joined
Jan 15, 2008
Messages
3,531
Change these variables to be of Object type:

Rich (BB code):
    Dim appOutlook As Outlook.Application
    Dim nms As Outlook.Namespace
    Dim Folder As Outlook.MAPIFolder
Instead do this:

Rich (BB code):
    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:

Rich (BB code):
    ElseIf Folder.DefaultItemType <> olMailItem Then
becomes this:

Rich (BB code):
    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.
 
Last edited:

jeremyjohnolson

Board Regular
Joined
Apr 29, 2014
Messages
53
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

Board Regular
Joined
Apr 29, 2014
Messages
53
It works! Thank you. Here is the new code

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

Board Regular
Joined
Apr 29, 2014
Messages
53
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???
 

iliace

Well-known Member
Joined
Jan 15, 2008
Messages
3,531
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

Board Regular
Joined
Apr 29, 2014
Messages
53
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.
 

Forum statistics

Threads
1,082,144
Messages
5,363,381
Members
400,732
Latest member
robcooper2001

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top