Outlook run VBA script on email to move to folder based on 6-digit number in subject
Our company uses a 6-digit number for our projects. I'm attempting to create a script that will search the email subject for this 6-digit number, then find the subfolder that starts with this 6-digit number, and move the email to that folder.
In my searches for how to do this I've stolen some code and come up with the below. I put in some MsgBox commands in an attempt to figure out if things are working along the way. However when I run the code (Rules>Manage Rules and Alerts>Run Rules Now) I don't get an error and I don't get any MsgBox's. Anyone have any thoughts/comments on what I might be doing wrong?
Sub filterbyprojectnumber(Item As Outlook.MailItem)
Dim nsOutlook As Outlook.NameSpace
Dim MailDest As Outlook.Folder
Set nsOutlook = Application.GetNamespace("MAPI")
Set RegExp = CreateObject("VBScript.RegExp")
MsgBox Item.Subject
RegExp.Global = True
RegExp.Pattern = "([^d]|^)d{6}([^d]|$)"
If RegExp.Test(Item.Subject) Then
MsgBox Item.Subject
MailDest = FindInFolders(Application.Session.Folders, RegExp.Test(Item.Subject))
MsgBox MailDest
Item.Move MailDest
End If
End Sub
Function FindInFolders(TheFolders As Outlook.Folder, Name As String)
Dim SubFolder As Outlook.MAPIFolder
On Error Resume Next
Set FindInFolders = Nothing
For Each SubFolder In TheFolders
If LCase(SubFolder.Name) Like LCase(Name) Then
Set FindInFolders = SubFolder
Exit For
Else
Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
If Not FindInFolders Is Nothing Then Exit For
End If
Next
End Function
email microsoft-outlook vba
add a comment |
Our company uses a 6-digit number for our projects. I'm attempting to create a script that will search the email subject for this 6-digit number, then find the subfolder that starts with this 6-digit number, and move the email to that folder.
In my searches for how to do this I've stolen some code and come up with the below. I put in some MsgBox commands in an attempt to figure out if things are working along the way. However when I run the code (Rules>Manage Rules and Alerts>Run Rules Now) I don't get an error and I don't get any MsgBox's. Anyone have any thoughts/comments on what I might be doing wrong?
Sub filterbyprojectnumber(Item As Outlook.MailItem)
Dim nsOutlook As Outlook.NameSpace
Dim MailDest As Outlook.Folder
Set nsOutlook = Application.GetNamespace("MAPI")
Set RegExp = CreateObject("VBScript.RegExp")
MsgBox Item.Subject
RegExp.Global = True
RegExp.Pattern = "([^d]|^)d{6}([^d]|$)"
If RegExp.Test(Item.Subject) Then
MsgBox Item.Subject
MailDest = FindInFolders(Application.Session.Folders, RegExp.Test(Item.Subject))
MsgBox MailDest
Item.Move MailDest
End If
End Sub
Function FindInFolders(TheFolders As Outlook.Folder, Name As String)
Dim SubFolder As Outlook.MAPIFolder
On Error Resume Next
Set FindInFolders = Nothing
For Each SubFolder In TheFolders
If LCase(SubFolder.Name) Like LCase(Name) Then
Set FindInFolders = SubFolder
Exit For
Else
Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
If Not FindInFolders Is Nothing Then Exit For
End If
Next
End Function
email microsoft-outlook vba
add a comment |
Our company uses a 6-digit number for our projects. I'm attempting to create a script that will search the email subject for this 6-digit number, then find the subfolder that starts with this 6-digit number, and move the email to that folder.
In my searches for how to do this I've stolen some code and come up with the below. I put in some MsgBox commands in an attempt to figure out if things are working along the way. However when I run the code (Rules>Manage Rules and Alerts>Run Rules Now) I don't get an error and I don't get any MsgBox's. Anyone have any thoughts/comments on what I might be doing wrong?
Sub filterbyprojectnumber(Item As Outlook.MailItem)
Dim nsOutlook As Outlook.NameSpace
Dim MailDest As Outlook.Folder
Set nsOutlook = Application.GetNamespace("MAPI")
Set RegExp = CreateObject("VBScript.RegExp")
MsgBox Item.Subject
RegExp.Global = True
RegExp.Pattern = "([^d]|^)d{6}([^d]|$)"
If RegExp.Test(Item.Subject) Then
MsgBox Item.Subject
MailDest = FindInFolders(Application.Session.Folders, RegExp.Test(Item.Subject))
MsgBox MailDest
Item.Move MailDest
End If
End Sub
Function FindInFolders(TheFolders As Outlook.Folder, Name As String)
Dim SubFolder As Outlook.MAPIFolder
On Error Resume Next
Set FindInFolders = Nothing
For Each SubFolder In TheFolders
If LCase(SubFolder.Name) Like LCase(Name) Then
Set FindInFolders = SubFolder
Exit For
Else
Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
If Not FindInFolders Is Nothing Then Exit For
End If
Next
End Function
email microsoft-outlook vba
Our company uses a 6-digit number for our projects. I'm attempting to create a script that will search the email subject for this 6-digit number, then find the subfolder that starts with this 6-digit number, and move the email to that folder.
In my searches for how to do this I've stolen some code and come up with the below. I put in some MsgBox commands in an attempt to figure out if things are working along the way. However when I run the code (Rules>Manage Rules and Alerts>Run Rules Now) I don't get an error and I don't get any MsgBox's. Anyone have any thoughts/comments on what I might be doing wrong?
Sub filterbyprojectnumber(Item As Outlook.MailItem)
Dim nsOutlook As Outlook.NameSpace
Dim MailDest As Outlook.Folder
Set nsOutlook = Application.GetNamespace("MAPI")
Set RegExp = CreateObject("VBScript.RegExp")
MsgBox Item.Subject
RegExp.Global = True
RegExp.Pattern = "([^d]|^)d{6}([^d]|$)"
If RegExp.Test(Item.Subject) Then
MsgBox Item.Subject
MailDest = FindInFolders(Application.Session.Folders, RegExp.Test(Item.Subject))
MsgBox MailDest
Item.Move MailDest
End If
End Sub
Function FindInFolders(TheFolders As Outlook.Folder, Name As String)
Dim SubFolder As Outlook.MAPIFolder
On Error Resume Next
Set FindInFolders = Nothing
For Each SubFolder In TheFolders
If LCase(SubFolder.Name) Like LCase(Name) Then
Set FindInFolders = SubFolder
Exit For
Else
Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
If Not FindInFolders Is Nothing Then Exit For
End If
Next
End Function
email microsoft-outlook vba
email microsoft-outlook vba
asked Jan 16 at 21:44
tincanfurytincanfury
161
161
add a comment |
add a comment |
0
active
oldest
votes
Your Answer
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "3"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fsuperuser.com%2fquestions%2f1395133%2foutlook-run-vba-script-on-email-to-move-to-folder-based-on-6-digit-number-in-sub%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
0
active
oldest
votes
0
active
oldest
votes
active
oldest
votes
active
oldest
votes
Thanks for contributing an answer to Super User!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fsuperuser.com%2fquestions%2f1395133%2foutlook-run-vba-script-on-email-to-move-to-folder-based-on-6-digit-number-in-sub%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown