Script to fetch data from mails in restricted collection and sending them to excel

Not open for further replies.


Hi Could someone review the below given code and help me to sort out the error?
The script is meant to fetch data from mails in a particular date range using pattern matching with regex, and send those data to an excel file. But I have been getting errors while running this script. The script should run against a folder called 'arjun' and then look for mails which matches the required pattern.

Sub mailsInRestrcitedCollectionP1S3()
Dim objOutlook As Outlook.Application
Dim objNameSpace As Outlook.NameSpace
Dim objSourceFolder As Outlook.Folder
Dim drDate, StartDate, EndDate, StarD, EndD As Date
Dim mailCount As Integer
Dim objVariant, Row, Priority, i As Variant
Dim olItem
Dim itms As Outlook.Items
Dim filteredItms As Outlook.Items
Dim N As Integer
Dim strRestrict, subjct, mailBody, strtTime, resoTime, incTickt, Category, Location As String
Dim ExcelSheet As Object
Dim regexpSubjectCheck, regexpLocation, regexpCategory, regexpdataFromBody As RegExp
Dim M, P, D As MatchCollection
'Dim Category, Location As Object
Dim oMatch, oMatches

Set objOutlook = Application
Set objNameSpace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNameSpace.Folders("").Folders("Inbox").Folders("arjun")

Set ExcelSheet = CreateObject("Excel.Sheet")

StartDate = InputBox("the date in format m/d/yyyy", "Start Date")
EndDate = InputBox("the date in format m/d/yyyy", "End Date")

StarD = Format(StartDate, "m/d/yyyy")
EndD = Format(EndDate, "m/d/yyyy")

strRestrict = "[ReceivedTime] > '" & StarD & "' AND [ReceivedTime] < '" & EndD + 1 & "' "

Set itms = objSourceFolder.Items
Set filteredItms = itms.Restrict(strRestrict)

Set regexpSubjectCheck = New RegExp
With regexpSubjectCheck
.Pattern = "(\s*FINAL:\s*INCIDENT NOTICE:\s*OneNet\s*\(MPLS\))|(\s*FINAL:\s*INCIDENT NOTICE:\s*US WAN connectivity)|(FINAL:\s*INCIDENT NOTICE:\s*OneNet\s*\(iVPN\))|(\s*FINAL:\s*INCIDENT NOTICE:\s*WAN/MAN\s*Connectivity)|(\s*FINAL:\s*INCIDENT NOTICE:\s*VPN Connectivity)|(\s*FINAL:\s*INCIDENT NOTICE:\s*GWAN\s*II)"
.Global = True
End With

Set regexpLocation = New RegExp
With regexpLocation
.Pattern = ("-\s*\w*\,*\s*\w*")
.Global = True
End With

Set regexpCategory = New RegExp
With regexpCategory
.Pattern = "(\s*OneNet\s*\(MPLS\))|(\s*US WAN connectivity)|(\s*OneNet\s*\(iVPN\))|(\s*WAN/MAN Connectivity)|(\s*VPN Connectivity)|(\s*GWAN\s*II)|(\s*Internet VPN\s*\(I-VPN\))"
.Global = False
End With

Set regexpdataFromBody = New RegExp
With regexpdataFromBody
.Pattern = "(START TIME:\s*\d{2}-\w{3}-\d{4}\s*\d{2}:\d{2}\s*GMT)|(RESOLUTION TIME:\s*\d{2}-\w{3}-\d{4}\s*\d{2}:\d{2}\s*GMT)|(SERVICENOW TICKET: INC\d{7})"
.Global = True
End With

Row = 1

For i = filteredItms.count To 1 Step -1

Set objVariant = filteredItms.item(i)
subjct = objVariant.subject
mailBody = objVariant.Body

If regexpSubjectCheck.Test(subjct) Then
Priority = "P1S3"
End If

Set M = regexpLocation.Execute(subjct)
Location = M(0).Value

Set P = regexpCategory.Execute(subjct)
Category = P(0).Value

Set D = regexpdataFromBody.Execute(mailBody)
strtTime = D(0).Value
resoTime = D(1).Value
incTickt = D(2).Value

ExcelSheet.Application.Cells(Row, 1) = incTickt
ExcelSheet.Application.Cells(Row, 2) = oMatch
ExcelSheet.Application.Cells(Row, 3) = Category
ExcelSheet.Application.Cells(Row, 4) = Priority
ExcelSheet.Application.Cells(Row, 5) = strtTime
ExcelSheet.Application.Cells(Row, 6) = resoTime

If regexpCategory.Test(subjct) Then
Row = Row + 1
End If


ExcelSheet.SaveAs "C:\Script\p1s3.xls"

Set ExcelSheet = Nothing

End Sub
Not open for further replies.