Add reference Microsoft Outlook XX.X object Library
Sub OutlookTesting()
Dim folders As Outlook.folders
Dim folder As Outlook.MAPIFolder
Dim iRow As Integer
Dim Pst_Folder_Name
Dim MailboxName
Dim UnRow As Integer
Dim RESS As Outlook.Recipient
Dim Flag As Integer
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olfldr As Outlook.MAPIFolder
Dim foldername As Outlook.MAPIFolder
Dim sharedemail As Outlook.Recipient
Const SharedMailboxName As String = "abc@xyz.com" ' <-- font="" mailbox="" name="" shared="" your="">-->
<-- mailbox="" name="" p="" shared="" your="">
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set sharedemail = olNS.CreateRecipient(SharedMailboxName)
For x = 1 To olNS.Stores.Count ' <-- all="" and="" configured="" i="" iterate="" mailbox="" mailboxes="" on="" outlook="" select="" target="" thorough="">--><-- all="" and="" configured="" iterate="" mailbox="" mailboxes="" on="" outlook="" p="" select="" target="" thorough="">
If olNS.Stores.Item(x).DisplayName = SharedMailboxName Then
Set olfldr = olNS.Stores.Item(x).GetDefaultFolder(olFolderInbox)
End If
Next
Set folder = olfldr
If folder = "" Then
MsgBox "Invalid Data in Input"
GoTo end_lbl1:
End If
'Read Through each Mail and export the details to Excel for Email Archival
Count = 1
For iRow = folder.Items.Count To 1 Step -1
If (folder.Items(iRow).UnRead) Then
ActiveSheet.Cells(Count + 1, 1).Value = folder.Items(iRow).SenderEmailAddress
ActiveSheet.Cells(Count + 1, 2).Value = folder.Items(iRow).Subject
ActiveSheet.Cells(Count + 1, 3).Value = folder.Items(iRow).To
ActiveSheet.Cells(Count + 1, 4).Value = folder.Items(iRow).Body
ActiveSheet.Cells(Count + 1, 5).Value = folder.Items(iRow).ReceivedTime
ActiveSheet.Cells(Count + 1, 6).Value = folder.Items(iRow).SentOn
ActiveSheet.Cells(Count + 1, 7).Value = folder.Items(iRow).Sensitivity
Count = Count + 1
End If
Next iRow
MsgBox "Outlook Mails Extracted to Excel"
end_lbl1:
End Sub
-->-->
Sub OutlookTesting()
Dim folders As Outlook.folders
Dim folder As Outlook.MAPIFolder
Dim iRow As Integer
Dim Pst_Folder_Name
Dim MailboxName
Dim UnRow As Integer
Dim RESS As Outlook.Recipient
Dim Flag As Integer
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olfldr As Outlook.MAPIFolder
Dim foldername As Outlook.MAPIFolder
Dim sharedemail As Outlook.Recipient
Const SharedMailboxName As String = "abc@xyz.com" ' <-- font="" mailbox="" name="" shared="" your="">-->
<-- mailbox="" name="" p="" shared="" your="">
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set sharedemail = olNS.CreateRecipient(SharedMailboxName)
For x = 1 To olNS.Stores.Count ' <-- all="" and="" configured="" i="" iterate="" mailbox="" mailboxes="" on="" outlook="" select="" target="" thorough="">--><-- all="" and="" configured="" iterate="" mailbox="" mailboxes="" on="" outlook="" p="" select="" target="" thorough="">
If olNS.Stores.Item(x).DisplayName = SharedMailboxName Then
Set olfldr = olNS.Stores.Item(x).GetDefaultFolder(olFolderInbox)
End If
Next
Set folder = olfldr
If folder = "" Then
MsgBox "Invalid Data in Input"
GoTo end_lbl1:
End If
'Read Through each Mail and export the details to Excel for Email Archival
Count = 1
For iRow = folder.Items.Count To 1 Step -1
If (folder.Items(iRow).UnRead) Then
ActiveSheet.Cells(Count + 1, 1).Value = folder.Items(iRow).SenderEmailAddress
ActiveSheet.Cells(Count + 1, 2).Value = folder.Items(iRow).Subject
ActiveSheet.Cells(Count + 1, 3).Value = folder.Items(iRow).To
ActiveSheet.Cells(Count + 1, 4).Value = folder.Items(iRow).Body
ActiveSheet.Cells(Count + 1, 5).Value = folder.Items(iRow).ReceivedTime
ActiveSheet.Cells(Count + 1, 6).Value = folder.Items(iRow).SentOn
ActiveSheet.Cells(Count + 1, 7).Value = folder.Items(iRow).Sensitivity
Count = Count + 1
End If
Next iRow
MsgBox "Outlook Mails Extracted to Excel"
end_lbl1:
End Sub
-->-->
No comments:
Post a Comment