Issue with Macro permissions resetting upon restart RRS feed

  • Question

  • Hello,

    I have a task where I need to run a Macro script written in VBA for outlook, which will then be deployed. The script works great so far, but my issue is that I get an error message when running the script after I restart outlook.

    Fresh install, if I go t Alt + F11 and create a NEW VBAProject.OTM and paste the code (found below) and save it, I am able to run the macro using F5. I can run it as many times as I'd like with no issue at all. However, if I save the project and then exit out of Outlook 2010, then re-open Outlook, navigate back to Alt + F11 and then try to execute the macro using F5, I get a message saying "The macros in this project are disabled. Please refer to the online...". I have my File > Options > Trust Center > Trust Center Settings > Macro Settings > Enable All Macros checked. In order to fix this I have to navigate to C:\Users\alexander\AppData\Roaming\Microsoft\Outlook\VBAProject.OTM and delete the OTM file. I am then able to create a new VBAProject and then repeat the entire process over again.

    I am not exactly sure how to phrase this question, but why does the Macro work when I have a freshly created project yet if I save and restart outlook the macro is suddenly disabled? Is there anyone to get this Macro to persist after a restart?

    Code is pasted below.

    Sub FindFolderByName()
        Dim Name As String
        Dim FoundFolder As Folder
        Name = InputBox("Find Name:", "Search Folder")
        If Len(Trim$(Name)) = 0 Then Exit Sub
        Set FoundFouder = FindInFolders(Application.Session.Folders, Name)
      If Not FoundFouder Is Nothing Then
        If MsgBox("Activate Folder: " & vbCrLf & FoundFouder.FolderPath, vbQuestion Or vbYesNo) = vbYes Then
          Set Application.ActiveExplorer.CurrentFolder = FoundFouder
        End If
        MsgBox "Not Found", vbInformation
      End If
    End Sub
    Function FindInFolders(TheFolders As Outlook.Folders, 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
          Set FindInFolders = FindInFolders(SubFolder.Folders, Name)
          If Not FindInFolders Is Nothing Then Exit For
        End If
    End Function

    • Moved by Steve Fan Wednesday, June 7, 2017 8:26 AM
    Tuesday, June 6, 2017 6:49 PM

All replies

  • Hi,

    Since your question is more related to VBA, I'll move it to the Outlook for Developers forum:

    The reason why we recommend posting appropriately is you will get the most qualified pool of respondents, and other partners who read the forums regularly can either share their knowledge or learn from your interaction with us. Thank you for your understanding.


    Steve Fan

    Please remember to mark the replies as answers if they helped.

    If you have feedback for TechNet Subscriber Support, contact

    Wednesday, June 7, 2017 8:26 AM
  • Hello,

    Please create a simple macro like showing a message using Msgbox to confirm the issue is not related to certain code.

    What is the detail version number of your office, do you install all the Office updates and what is your OS version?

    Do you have any group policy settings to disable the macro? Do you try to repair the Office and would it be fixed?

    If you choose other settings like Notifications for all macros, would you need to re-create the OTM?

    MSDN Community Support
    Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact

    Thursday, June 8, 2017 3:19 AM
  • Only just seen this moments after posting my own question - looks like we have the exact same issue -
    Monday, June 12, 2017 3:12 PM