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
        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
    If (oParent.Folders.Count > 0) Then
        For Each oFolder In oParent.Folders
            ProcessFolder oFolder
    End If
    End Sub

    Friday, September 20, 2019 3:33 AM