How to export plan comments to excel ?

itsanshulhere

Hi,

I use an alternative way using the fact that I receive an e-mail when a new comment is posted. Although maybe there are better options, this works fine for me.

I have a Folder in outlook where the Planner e-mails are moved automatically that is called "Planner e-mails", but it can work with the main folder if needed. When an e-mail is added to this folder the following code is executed, where the Title, Date and Body text is passed to another macro which open an Excel file and to paste the data.

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
  Dim outlookApp As Outlook.Application
  Dim objectNS As Outlook.NameSpace
  Dim inboxItems As Outlook.Items
  Dim item As Object
  Dim myTitle As Outlook.MailItem
  Dim myDate, myBody  As String
  Dim DataArray(3) As Variant

  Set outlookApp = Outlook.Application
  Set objectNS = outlookApp.GetNamespace("MAPI")
  Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("Planner e-mails").Items

Set item = objectNS.GetItemFromID(EntryIDCollection)

If TypeName(item) = "MailItem" Then
    If InStr(item.Subject, "RE: Comments on task ") <> 0 Then
        Set myTitle = item
        myDate = item.CreationTime
        myBody = item.Body
        DataArray(1) = myTitle
        DataArray(2) = myDate
        DataArray(3) = myBody
        OpenExcelFileFromOutlookVBA (DataArray)
    
    End If
    'Result = MsgBox(MessageInfo, vbOKOnly, "New Message Received")
End If

End Sub

The macro to open the Excel file is the following. Then in that Excel file there is a macro "Module3.InsertOutlookComments" to paste the data.

Sub OpenExcelFileFromOutlookVBA(DataArray)

'To make sure the excel application was available from within outlook I had to go into the menus and make sure the reference was available.
'tools>references>'Microsoft Excel 16.0 Obecjt Library' (or similar)
    
    ' Excel Application, workbook, and sheet object
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Object
    
    ' Filename
    Dim fileDoesExist As Boolean
    Dim FileName As String
    
    ' Create Excel Application
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    
    Set xlBook = xlApp.Workbooks.Open("S:\Excel file.xlsm")
    Set xlSheet = xlBook.Sheets(1)

    
    ' Do stuff with Excel workbook
    With xlApp
        With xlBook
            
            Dim Comment As String
            Dim CommentDate As Date
            Dim Project As String
                       
            CommentDate = DataArray(2)
            
            If DateDiff("n", CommentDate, Now()) < 10 Then
                Comment = Left(DataArray(3), 20)
                Project = DataArray(1)
                
                xlBook.Application.Run "Module3.InsertOutlookComments", DataArray
                
            End If
           
        End With
    End With
    xlBook.Close SaveChanges:=True
    xlApp.Quit
End Sub