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: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
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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.
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:
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
which it looks very much like it does, then yes.
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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.
I'm not especially conversant with the Outlook object model so perhaps browsing http://www.vbaexpress.com/forum/foru...8-Outlook-Help would help?
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
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.
'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?