-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathFinal Outlook code
More file actions
97 lines (72 loc) · 2.04 KB
/
Final Outlook code
File metadata and controls
97 lines (72 loc) · 2.04 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
Sub Application_Start()
On Error GoTo ErrHandler
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim workbookFile As String
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim itm As Object
Dim EndDate As Date
Dim acc As Account
'Folder path and file name of an existing Excel workbook
Set nms = Application.GetNamespace("MAPI")
workbookFile = "C:\Users\Public\dist\Major_event_manager\AR.xlsx"
For Each acc In nms.Accounts
If acc ="inoc@tatacommunications.com" then
Set fld = acc.DeliveryStore.GetDefaultFolder(olFolderInbox)).Folders("ME and AR")
End If
Next
'Select export folder
'
'Set fld = nms.PickFolder
'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
ElseIf fld.Items.Count = 0 Then
MsgBox "There are no mail messages to export", vbOKOnly, _
"Error"
Exit Sub
End If
'Open and activate Excel workbook.
Set appExcel = CreateObject("Excel.Application")
Set wkb = appExcel.Workbooks.Open(workbookFile)
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True
Set rng = wks.Range("A1")
'Copy field items in mail folder.
For Each itm In fld.Items
If itm.Class = Outlook.OlObjectClass.olMail Then
Set msg = itm
If InStr(msg.Subject, "AR") Or InStr(msg.Subject, "Failure Notification") > 0 Then
rng.Offset(0, 0).Value = msg.To
rng.Offset(0, 1).Value = msg.SenderEmailAddress
rng.Offset(0, 2).Value = msg.Subject
rng.Offset(0, 3).Value = msg.SentOn
rng.Offset(0, 4).Value = msg.Body
Set rng = rng.Offset(1, 0)
End If
End If
End If
Next
wkb.Close SaveChanges:=True
Set appExcel = Nothing
Exit Sub
ErrHandler:
If Err.Number = 1004 Then
MsgBox workbookFile & " doesn't exist", vbOKOnly, _
"Error"
Else
MsgBox "Error number: " & Err.Number & vbNewLine & _
"Description: " & Err.Description, vbOKOnly, "Error"
End If
End Sub