asked on
Sub sumit()
readMails
End Sub
Function readMails()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.Namespace
Dim olItem As Outlook.MailItem
Dim i As Integer
Dim b As Integer
Dim olInbox As Outlook.MAPIFolder
Dim olFolder As Outlook.MAPIFolder
Dim lngCol As Long
Dim oMsg As Outlook.MailItem
Dim mainWB As Workbook
Dim keyword
Dim Path
Dim Count
Dim Atmt
Dim f_random
Dim Filename
'Dim olInbox As inbo
Set olApp = New Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
Set mainWB = ActiveWorkbook
Set olInbox = olNamespace.GetDefaultFolder(Outlook.olFolderInbox)
Dim oItems As Outlook.Items
Set oItems = olInbox.Items
mainWB.Sheets("Main").Range("A:A").Clear
mainWB.Sheets("Main").Range("B:B").Clear
mainWB.Sheets("Main").Range("A1,B1").Interior.ColorIndex = 46
Path = mainWB.Sheets("Main").Range("J5").Value
keyword = mainWB.Sheets("Main").Range("J3").Value
mainWB.Sheets("Main").Range("A1").Value = "Number"
mainWB.Sheets("Main").Range("B1").Value = "Subject"
mainWB.Sheets("Main").Range("A1,B1").Borders.Value = 1
'MsgBox olInbox.Items.Count
Count = 2
For i = 1 To oItems.Count
If TypeName(oItems.Item(i)) = "MailItem" Then
Set oMsg = oItems.Item(i)
If InStr(1, oMsg.Subject, keyword, vbTextCompare) > 0 Then
'MsgBox "asfsdfsdf"
'MsgBox oMsg.Subject
mainWB.Sheets("Main").Range("A" & Count).Value = Count - 1
mainWB.Sheets("Main").Range("B" & Count).Value = oMsg.Subject
For Each Atmt In oMsg.Attachments
f_random = Replace(Replace(Replace(Now, " ", ""), "/", ""), ":", "") & "_"
Filename = Path & f_random & Atmt.Filename
'MsgBox Filename
Atmt.SaveAsFile Filename
FnWait (1)
' i = i + 1
Next Atmt
Count = Count + 1
End If
End If
Next
'For Each olItem In olInbox.Items
'Cells(i, 1) = olItem.SenderName ' Sender
'Cells(i, 2) = olItem.Subject ' Subject
'Cells(i, 3) = olItem.ReceivedTime ' Received
' Cells(i, 4) = olItem.ReceivedByName ' Recepient
'Cells(i, 5) = olItem.UnRead ' Unread?
'If StrComp(olItem.Subject, "Special Subject", vbTextCompare) = 0 Then
'MsgBox IsNull(olItem.Subject)
'MsgBox "xxxx " & olItem.Subject
'
'i = i + 1
'If (i = 25) Then
'Exit For
' End If
'Next olItem
End Function
Function FnWait(intTime)
Dim newHour
Dim NewMinute
Dim newSecond
Dim waitTime
newHour = Hour(Now())
NewMinute = Minute(Now())
newSecond = Second(Now()) + intTime
waitTime = TimeSerial(newHour, NewMinute, newSecond)
Application.Wait waitTime
End Function