Hello guys i am trying to create a code that it could search for a subject word from my Outlook inbox and put all emails with this word subject into a worksheet and count each subject of these emails...
Thanks a lot
Hello guys i am trying to create a code that it could search for a subject word from my Outlook inbox and put all emails with this word subject into a worksheet and count each subject of these emails...
Thanks a lot
I don't know what you mean by "put all emails". If you mean put the body of the email into a cell, that won't always fit. The body may contain objects so fitting those into a cell would be challenge. If it has attachment(s), that is another issue too.
You might consider adding an Outlook Rule to move the emails to another folder. Of course a macro could move the emails to a folder or create the folder and move.
No I mean to put all emails subjects contains the word i choose from subjects For example i want to search emails to put in with the word "Upgrade" i want to show me when i run it something like this :
A B
Count Subject
5 Upgrade Dslam agg.thes
3 Upgrade switch asw.thes9ka.
I mean to search first specific word in each subject and just put into excel worksheet emails subjects with this word and a counter
How is count computed? What confuses me is that you have a 2 different counts but just one subject for each count.
Is the match word to subject case sensitive?
Sometimes, a simple workbook attached makes things more clear. Click Go Advanced button in lower right, and then Manage Attachments link below the reply box to upload a file.
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Dim olItem As Object
Dim dic As Dictionary
Dim i As Long
Dim Subject As String
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set dic = New Dictionary
For Each olItem In olFldr.Items
If olItem.Class = olMail Then
Subject =olItem.Subject
If dic.Exists(Subject) Then dic(Subject) = dic(Subject) + 1 Else dic(Subject) = 1
End If
Next olItem
With ActiveSheet
.Columns("A:B").Clear
.Range("A1:B1").Value = Array("Count", "Subject")
For i = 0 To dic.Count - 1
.Cells(i + 2, "A") = dic.Items()(i)
.Cells(i + 2, "B") = dic.Keys()(i)
Next
End With
End Sub
this is my code but this code sent all emails on a workbook. I need to make this code with searching first a specific word on subject and seperate to different worksheets
If you could help me i would be grateful
Thank you
untested, perhaps:Code:Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Dim olItem As Object
Dim dic As Dictionary
Dim i As Long
Dim Subject As String
Dim SoughtWord As String
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set dic = New Dictionary
SoughtWord = "Upgrade"
For Each olItem In olFldr.Items
If olItem.Class = olMail Then
Subject = olItem.Subject
If InStr(Subject, SoughtWord, vbTextCompare) > 0 Then
If dic.Exists(Subject) Then dic(Subject) = dic(Subject) + 1 Else dic(Subject) = 1
End If
End If
Next olItem
With ActiveSheet
.Columns("A:B").Clear
.Range("A1:B1").Value = Array("Count", "Subject")
For i = 0 To dic.Count - 1
.Cells(i + 2, "A") = dic.Items()(i)
.Cells(i + 2, "B") = dic.Keys()(i)
Next
End With
Run-time error '13'
Type mismatch
on line If InStr(Subject, SoughtWord, vbTextCompare) > 0 Then
Sorry, try:
If InStr(1, Subject, SoughtWord, vbTextCompare) > 0 Then
I think its worked i have check from emails if i received the right number of emails for this subject
Thanks a lot mate
This code export all emails from inbox right? (with this subject word)
It doesn't export anything.Quote:
Originally Posted by antokout
It copies the Subject (text) of email items containing the string sought (Upgrade) and then groups identical Subjects giving a count of each one.
If the inbox is the result of:Quote:
Originally Posted by antokout
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
which it looks very much like it does, then yes.
yy that was i mean with export copy the subject but i think that it doesnt because i try with a word "Peakflow"
with this word i have at least 100 emails received and it copies only 5
And if i want to copy and from inbox and from some specific folders?
Then you'll need to know the folder hierarchy/names. There may be some sub-folders under the inbox, or possibly some other folders in your olNs object.Quote:
Originally Posted by antokout
I'm not especially conversant with the Outlook object model so perhaps browsing http://www.vbaexpress.com/forum/foru...8-Outlook-Help would help?
Setting the Outlook folder can be somewhat straightforward or a little odd. Here is a short example. Be sure to set the References as commented.
If you don't know the path, as shown at the end of the SetFolder routine, try selecting the folder in Outlook, and then uncomment the 3 consecutive comments. View Immediate Window results after a run.
Code:'https://www.extendoffice.com/documents/outlook/3747-outlook-auto-download-save-attachments-to-folder.html'or
'https://www.excelguru.ca/forums/showthread.php?9073-VBA-to-automatically-extract-email-attachments-and-save-them-into-a-specific-file
Sub SetFolder() 'Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK
Dim OL As Outlook.Application
Dim objRecipient As Outlook.Recipient, objAction As Outlook.Action
'Dim objFolder As Outlook.MAPIFolder
Dim objFolder As Outlook.Folder 'For Gmail Task's folder
Set OL = CreateObject("Outlook.Application")
'Set objFolder = OL.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks) 'olFolderTasks=13
'Set objFolder = OL.GetNamespace("MAPI").PickFolder
'Debug.Print objFolder.Name, objFolder.FolderPath
Set objFolder = GetFolderPath("\\ken@gmail.com\Puppy\Pics", OL)
Debug.Print objFolder.Name, objFolder.FolderPath
End Sub
'Similar to, http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#GetFolderPath
''Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK
Function GetFolderPath(ByVal FolderPath As String, oApp As Outlook.Application) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
'Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
Set oFolder = oApp.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function
Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olMailItem As Outlook.MailItem
Dim olItem As Object
Dim dic As Dictionary
Dim i As Long
Dim Subject As String
Dim SoughtWord As String
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set dic = New Dictionary
SoughtWord = "Upgrade"
For Each olItem In olFldr.Items
If olItem.Class = olMail Then
Subject = olItem.Subject
If InStr(Subject, SoughtWord, vbTextCompare) > 0 Then
If dic.Exists(Subject) Then dic(Subject) = dic(Subject) + 1 Else dic(Subject) = 1
End If
End If
Next olItem
With ActiveSheet
.Columns("A:B").Clear
.Range("A1:B1").Value = Array("Count", "Subject")
For i = 0 To dic.Count - 1
.Cells(i + 2, "A") = dic.Items()(i)
.Cells(i + 2, "B") = dic.Keys()(i)
Next
End With
If i worked on this and change this line
Set olFldr = olNs.GetDefaultFolder(olFolderInbox) and do something like this
Set olFldr = olNs.GetDefaultFolder(olFolderInbox).Folders("name of folder").Folders("name of folder") ? it shouldnt work?
No.
so the code you send me what will show me on excel?
Set objFolder = GetFolderPath("\\ken@gmail.com\Puppy\Pics", OL)
On this line i should choose the folder i want?