Outlook VBA code not running

Hi all, I'm new to VBA and need some help.

I wrote a script that will be triggered when new emails arrive (using Rules). It used to work properly but now it doesn't. I tried to click "Run Rules Now". Normally, a message box (as shown in the attachment) should appear. But now, it disappear immediately that I can hardly see it. To confirm if the code is ignored by VBA or not, I put MsgBox ("Started") at the very beginning of the code. The MsgBox did not appear so I guess the script did not even started.

I'm confused why the script suddenly stop working and want to know how to solve this problem.

Here's more detail of what I have done. My aim is to download attachments from a shared mailbox whenever new emails arrive. I set up a rule to detect the arrival of new emails and wrote a script to download attachments. I tried the download function in my own mailbox first and the code is this:

Code:

---

Sub SaveAttachmentsToDisk(MItem As Outlook.MailItem)

MsgBox ("Started")

Dim oAttachment As Outlook.Attachment

Dim sSaveFolder As String

Dim strFile As String

Dim sFileType As String
sSaveFolder = "(name of my folder)"

For Each oAttachment In MItem.Attachments

strFile = oAttachment.FileName

sFileType = LCase$(Right$(strFile, 5))
'MsgBox (sFileType)
If sFileType = ".xlsm" Then

oAttachment.SaveAsFile sSaveFolder & "" & oAttachment.DisplayName

End If

Next

End Sub

---

The code above worked. I tried methods like CreateRecipient and GetSharedDefaultFolder to access the shared mailbox but all failed. This is not the problem. The problem is that after this, when I tried to run the above code again, this situation I mentioned in #1 happened.

Some information that may be useful:
- my company disabled Macro
- no matter I put the above code in Module or in ThisOutlookSession, the situation in #1 happened.

Maybe run this and see if it works

Code:

---

Public Sub SaveAttachments(Item As Outlook.MailItem)
If Item.Attachments.Count > 0 Then
    Dim objAttachments As Outlook.Attachments
    Dim lngCount As Long
    Dim strFile As String
    Dim sFileType As String
    Dim i As Long
    Set objAttachments = Item.Attachments
    lngCount = objAttachments.Count
    For i = lngCount To 1 Step -1
        ' Get the file name.
        strFile = objAttachments.Item(i).FileName
        ' Get the path to your My Documents folder
        strfolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
        strfolderpath = strfolderpath & "\Attachments"
        ' Combine with the path to the folder.
        strFile = strfolderpath & strFile
        ' Save the attachment as a file.
        objAttachments.Item(i).SaveAsFile strFile
    Next i
End If
End Sub

---

if this works then try to modify to save your .xlsm file attachment

Quote:

---

Originally Posted by Aussiebear

Maybe run this and see if it works

Code:

---

Public Sub SaveAttachments(Item As Outlook.MailItem)
If Item.Attachments.Count > 0 Then
    Dim objAttachments As Outlook.Attachments
    Dim lngCount As Long
    Dim strFile As String
    Dim sFileType As String
    Dim i As Long
    Set objAttachments = Item.Attachments
    lngCount = objAttachments.Count
    For i = lngCount To 1 Step -1
        ' Get the file name.
        strFile = objAttachments.Item(i).FileName
        ' Get the path to your My Documents folder
        strfolderpath = CreateObject("WScript.Shell").SpecialFolders(16)
        strfolderpath = strfolderpath & "\Attachments"
        ' Combine with the path to the folder.
        strFile = strfolderpath & strFile
        ' Save the attachment as a file.
        objAttachments.Item(i).SaveAsFile strFile
    Next i
End If
End Sub

---

if this works then try to modify to save your .xlsm file attachment

---

Thank you for your reply. The exact same code works on my colleague's computer, but when it comes to mine, it doesn't. The code seems never started running but there is no error code. I'm not sure if this is because I wrote something wrong before, which is asking the code to access the shared mailbox, so it now cannot recognize any of the mailbox.

This could be a security issue. See https://www.gmayor.com/create_and_em...gital_cert.htm

Quote:

---

Originally Posted by gmayor

This could be a security issue. See https://www.gmayor.com/create_and_em...gital_cert.htm

---

Thank you for you answer. The "Certificates snap-in" didn't show up, is this because I'm not the admin?

Quote:

---

Originally Posted by lcaoi

... is this because I'm not the admin?

---

Possibly, also you mentioned that the Company disabled the macro. Are you sure you want to go against their policy?

Quote:

---

Originally Posted by Aussiebear

Possibly, also you mentioned that the Company disabled the macro. Are you sure you want to go against their policy?

---

Thank you. Definitely don't want to go against the company's policy, I'll try ways other than VBA to complete my task.