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 Next xlWB.Close 1 If bXStarted Then xlApp.Quit 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
Tony
TKHussar