Export Email Properties to Excel RRS feed

  • Question

  • Hi

    This is the first time I have used VBA in MS Outlook and have found some code that does most of what I need to do.  However I am struggling to find a line of code that tells me if an email has been replied to and the date and time the reply was sent.  csan anyone help please.  The code I am using is copied below for information:

    Option Explicit
     Sub CopyToExcel()
     Dim xlApp As Object
     Dim xlWB As Object
     Dim xlSheet As Object
     Dim rCount As Long
     Dim bXStarted As Boolean
     Dim enviro As String
     Dim strPath As String
     Dim currentExplorer As Explorer
     Dim Selection As Selection
     Dim olItem As Outlook.MailItem
     Dim obj As Object
     Dim strColA, strColB, strColC, strColD, strColE, strColF, strColG, strColH, strColI, StrColJ As String
     Dim LDate As Date
    ' Get Excel set up
    enviro = CStr(Environ("USERPROFILE"))
    'the path of the workbook
     strPath = enviro & "\Outlook to Excel\test.xlsx"
         On Error Resume Next
         Set xlApp = GetObject(, "Excel.Application")
         If Err <> 0 Then
             Application.StatusBar = "Please wait while Excel source is opened ... "
             Set xlApp = CreateObject("Excel.Application")
             bXStarted = True
         End If
         On Error GoTo 0
         'Open the workbook to input the data
         Set xlWB = xlApp.Workbooks.Open(strPath)
         Set xlSheet = xlWB.Sheets("RawData")
        ' Process the message record
        On Error Resume Next
    'Find the next empty line of the worksheet
    rCount = xlSheet.Range("B" & xlSheet.Rows.Count).End(-14162).Row
    ' get the values from outlook
    Set currentExplorer = Application.ActiveExplorer
    Set Selection = currentExplorer.Selection
      For Each obj In Selection
        Set olItem = obj
    'collect the fields
        strColA = olItem.SenderName
        strColB = olItem.CreationTime
        strColC = olItem.To
        strColD = olItem.Recipients
        strColE = olItem.ReceivedByName
        strColF = olItem.SentOn
        strColG = olItem.ReceivedTime
        strColH = olItem.UnRead
        strColI = olItem.LastModificationTime
        StrColJ = olItem.UserProperties
    'Add column Headers to the Excel Extract
      xlSheet.Range("A" & 1) = "Sender Name"
      xlSheet.Range("B" & 1) = "Creation Time"
      xlSheet.Range("C" & 1) = "Sent To"
      xlSheet.Range("D" & 1) = "Recipients"
      xlSheet.Range("E" & 1) = "Received By Name"
      xlSheet.Range("F" & 1) = "Sent On"
      xlSheet.Range("G" & 1) = "Received Time"
      xlSheet.Range("H" & 1) = "UnRead"
      xlSheet.Range("I" & 1) = "Last Modification Time"
      xlSheet.Range("J" & 1) = "User Properties"
    'write them in the excel sheet
      xlSheet.Range("A" & rCount) = strColA
      xlSheet.Range("B" & rCount) = strColB
      xlSheet.Range("C" & rCount) = strColC
      xlSheet.Range("D" & rCount) = strColD
      xlSheet.Range("E" & rCount) = strColE
      xlSheet.Range("F" & rCount) = strColF
      xlSheet.Range("G" & rCount) = strColG
      xlSheet.Range("H" & rCount) = strColH
      xlSheet.Range("I" & rCount) = strColI
      xlSheet.Range("J" & rCount) = StrColJ
    'Next row
      rCount = rCount + 1
         xlWB.Close 1
         If bXStarted Then
         End If
         Set olItem = Nothing
         Set obj = Nothing
         Set currentExplorer = Nothing
         Set xlApp = Nothing
         Set xlWB = Nothing
         Set xlSheet = Nothing
     End Sub

    Many thanks in anticipation.

    Kind regards



    Friday, November 20, 2015 4:22 PM


All replies

  • Tony,

    As I'm sure you are aware, this forum is dedicated to questions/issues about customizing and programming Microsoft Project. Since your question is about Outlook and Excel I suggest you re-post to a forum for those applications. You might start with the following:


    Friday, November 20, 2015 5:28 PM
  • Thanks John.  I forgot.



    • Marked as answer by TKHussar Saturday, November 21, 2015 10:46 AM
    Saturday, November 21, 2015 10:46 AM