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
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.
Connect with Certified Experts to gain insight and support on specific technology challenges including:
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE