Outlook run VBA script on email to move to folder based on 6-digit number in subject












2















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









share|improve this question



























    2















    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









    share|improve this question

























      2












      2








      2








      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









      share|improve this question














      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






      share|improve this question













      share|improve this question











      share|improve this question




      share|improve this question










      asked Jan 16 at 21:44









      tincanfurytincanfury

      161




      161






















          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
          });


          }
          });














          draft saved

          draft discarded


















          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
















          draft saved

          draft discarded




















































          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.




          draft saved


          draft discarded














          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





















































          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







          Popular posts from this blog

          Probability when a professor distributes a quiz and homework assignment to a class of n students.

          Aardman Animations

          Are they similar matrix