farrissf
Member
- Outlook version
- Outlook 2016 32 bit
- Email Account
- Exchange Server
I have been wanting to use Categories to identify my emails for my construction projects, I ran across this article Create a List of Color Categories to Merge or Restore which gave me the key to uploading all my project codes as categories. Thanks to you, I am all set up to start using my new codes. My plan was to put the emails in folders so I could find them. I saw a really cool tool on a website you had a link to called, Category Manager on the VB Office.net site. I was fine with paying for it so I tried to download but I have no admin rights, I am not interested in losing my job and I have tons of macros and add-ins in Excel so I decided to try and create something. This has turned into a nightmare but I am knee-deep and would like to finish it. I have used my own basic knowledge with ChatGPT to get this far, but I am stuck. I started with this and it works but as you will see it is not user-friendly.
I want to modify the code to where it would give me a dropdown list of the categories. I tried to cajole ChatGPT into creating something but it has failed at every turn.
User Form Code:
Module
I would prefer to have a well-thought-out approach (an app like the Catagory Manager) I am not opposed to paying for it within reason (hopefully less than a hundy). The macro I had in mind would comb through my email looking for keywords and then apply a category.
I have really enjoyed your approach to macros, even if this post does not result in a solution, I wanted to say thanks for what you do. I would never even dreamed of these categories as a solution without your website, thank you!
farrissf
Code:
Sub CategorizeEmailsWithInputBox()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Object
Dim keywords As String
Dim keywordArray() As String
Dim keyword As Variant
Dim selectedCategory As String
' Prompt for keyword input
keywords = InputBox("Enter keywords to search for (separate with commas):", "Keyword Input")
' Check if any keywords were provided
If keywords = "" Then
Exit Sub ' Exit if no keywords entered
End If
' Split the keywords into an array
keywordArray = Split(keywords, ",")
' Initialize Outlook objects
Set olApp = Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
' Specify the folder where you want to search for emails
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
' Prompt for category selection using InputBox
selectedCategory = InputBox("Enter the category for the selected emails:", "Category Selection")
' Check if a category was selected
If selectedCategory = "" Then
Exit Sub ' Exit if no category selected
End If
' Loop through all emails in the folder
For Each olMail In olFolder.Items
For Each keyword In keywordArray
If InStr(1, olMail.Subject, Trim(keyword), vbTextCompare) > 0 Then
' Assign the selected category to the email
olMail.categories = selectedCategory
olMail.Save
Exit For ' Exit loop if a match is found
End If
Next keyword
Next olMail
' Clean up objects
Set olMail = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
End SubI want to modify the code to where it would give me a dropdown list of the categories. I tried to cajole ChatGPT into creating something but it has failed at every turn.
User Form Code:
Code:
Private Sub CommandButton1_Click()
LstNo = ComboBox1.ListIndex
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim objNameSpace As NameSpace
Dim objCategory As Category
Dim strOutput As String
Set objNameSpace = Application.GetNamespace("MAPI")
If objNameSpace.categories.Count > 0 Then
For Each objCategory In objNameSpace.categories
strOutput = objCategory.Name
With Me.ChosenCategory
.AddItem (strOutput)
End With
Next
With Me.ChosenCategory
.AddItem ("Clear Category")
End With
End If
End SubModule
Code:
Sub CategorizeEmailsWithUserForm()
Dim olApp As Outlook.Application
Dim olNamespace As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim olMail As Object
Dim keywords As String
Dim keywordArray() As String
Dim keyword As Variant
Dim selectedCategory As String
' Prompt for keyword input
keywords = InputBox("Enter keywords to search for (separate with commas):", "Keyword Input")
' Check if any keywords were provided
If keywords = "" Then
Exit Sub ' Exit if no keywords entered
End If
' Split the keywords into an array
keywordArray = Split(keywords, ",")
' Initialize Outlook objects
Set olApp = Outlook.Application
Set olNamespace = olApp.GetNamespace("MAPI")
' Specify the folder where you want to search for emails
Set olFolder = olNamespace.GetDefaultFolder(olFolderInbox)
' Show the CategorySelectionForm UserForm
UserForm1.Show
' Retrieve the selected category from the ComboBox on the UserForm
selectedCategory = CategorySelectionForm.ComboBox1.Value
' Check if a category was selected
If selectedCategory = "" Then
Exit Sub ' Exit if no category selected
End If
' Loop through all emails in the folder
For Each olMail In olFolder.Items
For Each keyword In keywordArray
If InStr(1, olMail.Subject, Trim(keyword), vbTextCompare) > 0 Then
' Assign the selected category to the email
olMail.categories = selectedCategory
olMail.Save
Exit For ' Exit loop if a match is found
End If
Next keyword
Next olMail
' Clean up objects
Set olMail = Nothing
Set olFolder = Nothing
Set olNamespace = Nothing
Set olApp = Nothing
End SubI would prefer to have a well-thought-out approach (an app like the Catagory Manager) I am not opposed to paying for it within reason (hopefully less than a hundy). The macro I had in mind would comb through my email looking for keywords and then apply a category.
I have really enjoyed your approach to macros, even if this post does not result in a solution, I wanted to say thanks for what you do. I would never even dreamed of these categories as a solution without your website, thank you!
farrissf
