VBA code required to extract email from outlook in date and time sequence-CodePudding

Im using below code to extract emails from outlook. However, when I extract the emails into the excel the emails doesnt get extracted in sequence base on date and time. The date format in my computes is ddmmyyyy format and the time zone is UK. I want the date to be in one column and the time to be in another column. Also i want to extract the email from specific sender. Sender email [email protected]

Im using below VBA code current and im new to VBA cant figure out to amend the code

Sub GetMailInfo()

Dim results() As String

' get contacts
results = ExportEmails(True)

' paste onto worksheet
Range(Cells(1, 1), Cells(UBound(results), UBound(results, 2))).Value = results

MsgBox "Completed"
End Sub

Function ExportEmails(Optional headerRow As Boolean = False) As String()

Dim objOutlook As Object ' Outlook.Application
Dim objNamespace As Object ' Outlook.Namespace
Dim strFolderName As Object
Dim objMailbox As Object
Dim objFolder As Object
Dim mailFolderItems As Object ' Outlook.items
Dim folderItem As Object
Dim msg As Object ' Outlook.MailItem
Dim tempString() As String
Dim i As Long
Dim numRows As Long
Dim startRow As Long
Dim jAttach As Long ' counter for attachments
Dim debugMsg As Integer

' select output results worksheet and clear previous results
Sheets("Outlook Results").Select
Sheets("Outlook Results").Cells.ClearContents
Range("A1").Select

Set objOutlook = CreateObject("Outlook.Application")
'MsgBox objOutlook, vbOKOnly 'for debugging
Set objNamespace = objOutlook.GetNamespace("MAPI")
'MsgBox objNamespace, vbOKOnly 'for debugging
'Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
'MsgBox objInbox, vbOKOnly 'for debugging
Set strFolderName = objNamespace.PickFolder
Set mailFolderItems = strFolderName.Items

' if calling procedure wants header row
If headerRow Then
startRow = 1
Else
startRow = 0
End If

numRows = mailFolderItems.Count

' resize array
ReDim tempString(1 To (numRows   startRow), 1 To 100)

' loop through folder items
For i = 1 To numRows
Set folderItem = mailFolderItems.Item(i)

If IsMail(folderItem) Then
Set msg = folderItem
End If

With msg
tempString(i   startRow, 1) = .SenderName
tempString(i   startRow, 2) = .ReceivedTime
tempString(i   startRow, 3) = .Subject
'tempString(i   startRow, 4) = Left$(.Body, 200)  ' throws error without limit
'tempString(i   startRow, 5) = .SenderEmailAddress
'tempString(i   startRow, 6) = .SentOn


End With

' adding file attachment names where they exist - added by JP
If msg.Attachments.Count > 50 Then

For jAttach = 1 To msg.Attachments.Count
tempString(i   startRow, 39   jAttach) = msg.Attachments.Item(jAttach).DisplayName
Next jAttach

End If

Next i

' first row of array should be header values
If headerRow Then


tempString(1, 1) = "SenderName"
tempString(1, 2) = "ReceivedTime"
tempString(1, 3) = "subject"
'tempString(1, 4) = "Body"
'tempString(1, 5) = "SenderEmailAddress"
'tempString(1, 6) = "SentOn"
End If

ExportEmails = tempString

' apply pane freeze and filtering

Range("A2").Select
ActiveWindow.FreezePanes = True
Rows("1:1").Select


'Selection.AutoFilter

End Function

Function IsMail(itm As Object) As Boolean
IsMail = (TypeName(itm) = "MailItem")
End Function

CodePudding user response：

The date/time format does not matter as long as you are adding the data as the DateTime type, not as string (you do that part correctly).

If you want a particular order, you can either resort the data later in Excel, or you can sort the Items collection first by calling Items.Sort

Set mailFolderItems = strFolderName.Items
mailFolderItems.Sort "[ReceivedTime]", false

CodePudding user response：

You need to sort the items collections before iterating over all entries. The Items.Sort method sorts the collection of items by the specified property. The index for the collection is reset to 1 upon completion of this method.

The MailItem.ReceivedTime which returns a Date indicating the date and time at which the item was received property can be used for sorting items in the folder.

mailFolderItems.Sort "[ReceivedTime]", False 

' loop through folder items
For i = 1 To numRows
  Set folderItem = mailFolderItems.Item(i)

Use the FormatDateTime function which returns an expression formatted as a date or time for your cells/rows.