VBA Outlook - Converting working code early binding to late binding

M

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
983
Office Version
  1. 2010
Platform
  1. Windows
Hi Team,

Below outlook code works, Need help in converting Early binding outlook code to late Binding.
Task was Red flagged emails needs to attach to new email.

Public filename As String
VBA Code: 
Sub Draft_Red_Flagged_emails()
       
    Dim Outlook_F_Path As String
    Outlook_F_Path = mac.Range("b4").Value  'Outlook folder path Example'\\abc@gmail.com\Inbox
        
    StartTime = Timer
     
     'Early Binding outlook
    Dim olApp As Outlook.Application
    Set olApp = New Outlook.Application
   
    Dim Main_Folder As Folder
    
    'Calling Function for outlook
    Set Main_Folder = GetOLFolder(Outlook_F_Path, olApp)
    Dim objMail As Outlook.MailItem
    
    Dim Item As Object
    Dim olItem As MailItem
    Dim objMsg As MailItem
    
    Set objMsg = olApp.CreateItem(olMailItem)
    Dim Filtered_Results As Object
    
    'Apply filter in outlook
    SFILTER = "[ReceivedTime]>'" & Format(Date, "DDDDD HH:NN") & "'"
    Set Filtered_Results = Main_Folder.Items.Restrict(SFILTER)
    
    'Date and Time for subject line
    T1 = Format(TimeValue(Now), "hh:mm AM/PM")
     D = Format(Date, "DD") & "/" & Format(Date, "MM") & "/" & Format(Date, "YYYY")
     
     
     'Check all mailItem which has Red Flag in search results (Restrict)
      
      For Each Item In Filtered_Results
        If TypeOf Item Is Outlook.MailItem Then
            
            MailRT = Item.ReceivedTime
            flagclr = Item.FlagIcon
            
            If flagclr = 6 Then
                    '3am to 2:30pm
                    'If TimeValue(currTime) >= TimeValue("3:00:00") And TimeValue(currTime) < TimeValue("14:30:00") Then
                If TimeValue(MailRT) >= mac.Range("A15").Value And TimeValue(MailRT) < mac.Range("B15").Value Then
                    With objMsg
                        .To = mac.Range("a10").Value
                        .CC = mac.Range("b10").Value
                        .Body = "Hi All," & vbNewLine & mac.Range("d11").Value
                        .Subject = mac.Range("c10").Value & " " & "(" & T1 & ")" & " - " & D  'Add Date and time to subject
                        .Attachments.Add Item
                        .Display
                      '.send
                    End With
                End If
            End If
        End If
    Next
               
  
  MsgBox "Macro Successful Time Taken " & Format(Timer - StartTime, "00:00") & " Seconds"
               
           
End Sub
 
 Sub PickOutlookFolder()
    Dim objNS As Namespace
    Dim objFolder As Object
    Dim strFolderPath As String
    Dim strEntryID As String
    'Set Outlook Object
    Set objNS = Outlook.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder
    If TypeName(objFolder) <> "Nothing" Then
        strFolderPath = objFolder.Folderpath
        strEntryID = objFolder.EntryID
    End If
    mac.Range("b4").Value = strFolderPath
    
End Sub


Function GetOLFolder(ByVal Folderpath As String, olApp As Outlook.Application) As Outlook.Folder
'Convert a string folder path to actual folder object, which lets you retrieve various folder properties
    Dim TestFolder      As Outlook.Folder
    Dim FoldersArray    As Variant
    Dim i               As Integer

    On Error GoTo GetFolder_Error
    If Left(Folderpath, 2) = "\\" Then
        Folderpath = Right(Folderpath, Len(Folderpath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(Folderpath, "\")
    Set TestFolder = olApp.Session.Folders.Item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.Item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetOLFolder = Nothing
            End If
        Next
    End If

    'Return the TestFolder
    Set GetOLFolder = TestFolder
    Exit Function

GetFolder_Error:
    Set GetOLFolder = Nothing
    Exit Function
End Function

Thanks
mg




T
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Sort by date Sort by votes
I think I got everything but this would have to be tested with your own file and environment.

Rich (BB code): 
Const olMailItem = 0 ' insert at top of module

Public filename As String
Sub Draft_Red_Flagged_emails()
      
    Dim Outlook_F_Path As String
    Outlook_F_Path = mac.Range("b4").Value  'Outlook folder path Example'\\abc@gmail.com\Inbox
       
    StartTime = Timer
    
     'Late Binding outlook
    Dim olApp As Object ' Outlook.Application
    Set olApp = CreateObject("Outlook.Application") ' New Outlook.Application
  
    Dim Main_Folder As Folder
   
    'Calling Function for outlook
    Set Main_Folder = GetOLFolder(Outlook_F_Path, olApp)
    Dim objMail As Object ' Outlook.MailItem
   
    Dim Item As Object
    Dim olItem As Object ' MailItem
    Dim objMsg As Object ' MailItem
   
    Set objMsg = olApp.CreateItem(olMailItem)
    Dim Filtered_Results As Object
   
    'Apply filter in outlook
    SFILTER = "[ReceivedTime]>'" & Format(Date, "DDDDD HH:NN") & "'"
    Set Filtered_Results = Main_Folder.Items.Restrict(SFILTER)
   
    'Date and Time for subject line
    T1 = Format(TimeValue(Now), "hh:mm AM/PM")
     D = Format(Date, "DD") & "/" & Format(Date, "MM") & "/" & Format(Date, "YYYY")
    
    
     'Check all mailItem which has Red Flag in search results (Restrict)
     
      For Each Item In Filtered_Results
        If TypeOf Item Is Outlook.MailItem Then
           
            MailRT = Item.ReceivedTime
            flagclr = Item.FlagIcon
           
            If flagclr = 6 Then
                    '3am to 2:30pm
                    'If TimeValue(currTime) >= TimeValue("3:00:00") And TimeValue(currTime) < TimeValue("14:30:00") Then
                If TimeValue(MailRT) >= mac.Range("A15").Value And TimeValue(MailRT) < mac.Range("B15").Value Then
                    With objMsg
                        .To = mac.Range("a10").Value
                        .CC = mac.Range("b10").Value
                        .Body = "Hi All," & vbNewLine & mac.Range("d11").Value
                        .Subject = mac.Range("c10").Value & " " & "(" & T1 & ")" & " - " & D  'Add Date and time to subject
                        .Attachments.Add Item
                        .Display
                      '.send
                    End With
                End If
            End If
        End If
    Next
              
 
  MsgBox "Macro Successful Time Taken " & Format(Timer - StartTime, "00:00") & " Seconds"
              
          
End Sub

Sub PickOutlookFolder()
    Dim objNS As Object ' Namespace
    Dim objFolder As Object
    Dim strFolderPath As String
    Dim strEntryID As String
    'Set Outlook Object
    Dim olApp As Object ' Outlook.Application
    Set olApp = CreateObject("Outlook.Application") ' New Outlook.Application

    Set objNS = olApp.GetNamespace("MAPI")
    Set objFolder = objNS.PickFolder
    If TypeName(objFolder) <> "Nothing" Then
        strFolderPath = objFolder.Folderpath
        strEntryID = objFolder.EntryID
    End If
    mac.Range("b4").Value = strFolderPath
   
End Sub


Function GetOLFolder(ByVal Folderpath As String, olApp As Object) As Object
'Convert a string folder path to actual folder object, which lets you retrieve various folder properties
    Dim TestFolder      As Object ' Outlook.Folder
    Dim FoldersArray    As Variant
    Dim i               As Integer

    On Error GoTo GetFolder_Error
    If Left(Folderpath, 2) = "\\" Then
        Folderpath = Right(Folderpath, Len(Folderpath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(Folderpath, "\")
    Set TestFolder = olApp.Session.Folders.Item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Object ' Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.Item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetOLFolder = Nothing
            End If
        Next
    End If

    'Return the TestFolder
    Set GetOLFolder = TestFolder
    Exit Function

GetFolder_Error:
    Set GetOLFolder = Nothing
    Exit Function
End Function
 
Upvote 0
Hi 6StringJazzer,
Thanks for your help, When run on actual data
Through early binding code it worked, But when I removed Microsoft Outlook reference for Late binding ,

Got Error on below lines.

Dim Filtered_Results As folder
Compile Error , user defined type not defined.


If TypeOf Item Is Outlook.MailItem Then
' Compile Error , user defined type not defined.

.Attachments.Add Item
' Connection to the server is unavailable, outlook must be online or connected to complete this action.

Thanks once again for your help !!


Regards,
mg
 
Upvote 0
Mallesh23 said:
Dim Filtered_Results As folder
Compile Error , user defined type not defined.
Click to expand...
Declare as Object instead of Folder

If TypeOf Item Is Outlook.MailItem Then
' Compile Error , user defined type not defined.
Click to expand...
This is a difficult one. In late binding, a MailItem would be declared as an Object but then the TypeOf operator would return False. So we need a different way to determine the item type. I have used this:

At the top of the module, with the other constant, add
VBA Code: 
Const olMail = 43

Then replace the line above with
VBA Code: 
 If Item.Class = olMail

.Attachments.Add Item
' Connection to the server is unavailable, outlook must be online or connected to complete this action.
Click to expand...
I do not recognize this error. If we can resolve all the other errors then we can return to this one.
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Early binding issue, reference to Microsoft Excel not working
2
Replies
10
Views
1K
Bering
B
C
  • Question Question
VBA attachments auto save help
Replies
0
Views
605
cxm687
C
R
  • Solved
VBA in Excel to find free appointment in Outlook and display in an email
Replies
8
Views
3K
RockEd
R
E
  • Question Question
Amend VBA code to extract details from outlook - Urgent help required
Replies
1
Views
1K
Peter_SSs
Peter_SSs
M
  • Question Question
VBA Outlook, Extract flagged mailitem of specified time
Replies
0
Views
540
Mallesh23
M

Forum statistics

Threads
1,223,889
Messages
6,175,223
Members
452,620
Latest member
dsubash

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top