none
Call Outllook Macro from Excel VBA RRS feed

  • Question

  • I want to call the following outlook macro using excel VBA. I would also like to refer the mydate1 and mydate2 from excel sheet only. I am okay for the conversion of same in excel macro. Thanks!
    Option Explicit
    
    Dim aOutput() As Variant
    Dim lCnt As Long
    
    
    
    
    Function SubFolders()
    '
    ' Code for Outlook versions 2007 and subsequent
    ' Declare with Folder rather than MAPIfolder
    '
    Dim xlApp As Excel.Application
    Dim xlSh As Object
    Dim xlWB As Object
    Dim strPath As String
    Dim enviro As String
    
    
    Dim olNs As NameSpace
    Dim olParentFolder As Folder
    
    Set olNs = GetNamespace("MAPI")
    Set olParentFolder = olNs.GetDefaultFolder(olFolderInbox)
    
    lCnt = 0
    ReDim aOutput(1 To 100000, 1 To 5)
    
    ProcessFolder olParentFolder
    
    On Error Resume Next
    Set xlApp = GetObject(, "Excel.Application")
    On Error GoTo 0
    If xlApp Is Nothing Then Set xlApp = CreateObject("Excel.Application")
    
    enviro = CStr(Environ("USERPROFILE"))
    strPath = enviro & "\Documents\test.xlsx"
    Set xlWB = xlApp.Workbooks.Open(strPath)
    Set xlSh = xlWB.Sheets("Sheet1")
    
    xlSh.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
    xlApp.Visible = True
    
    ExitRoutine:
        Set olNs = Nothing
        Set olParentFolder = Nothing
        Set xlApp = Nothing
        Set xlSh = Nothing
    
    End Function
    
    Private Sub ProcessFolder(ByVal oParent As Folder)
    
    Dim oFolder As Folder
    Dim oMail As Object
    Dim mydate1 As Date
    Dim mydate2 As Date
    
    mydate1 = "2019-8-31"
    mydate2 = "2019-9-20"
    
    
    For Each oMail In oParent.Items
    
        If TypeName(oMail) = "MailItem" And _
         oMail.ReceivedTime >= mydate1 And _
           oMail.ReceivedTime <= mydate2 Then
            lCnt = lCnt + 1
            aOutput(lCnt, 1) = oMail.SenderEmailAddress
            aOutput(lCnt, 2) = oMail.ReceivedTime
            aOutput(lCnt, 3) = oMail.Subject
            aOutput(lCnt, 4) = oMail.Sender
            aOutput(lCnt, 5) = oMail.To
            
        End If
        
    
    Next
    
    If (oParent.Folders.Count > 0) Then
        For Each oFolder In oParent.Folders
            ProcessFolder oFolder
        Next
    End If
    
    End Sub
    
    

    Friday, September 20, 2019 3:33 AM