Outlook VBA code not running

[lcaoi]

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.

[lcaoi]

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:

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.

[Aussiebear]

Maybe run this and see if it works

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

[lcaoi]

Maybe run this and see if it works

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.

[gmayor]

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

[lcaoi]

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?

[Aussiebear]

... 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?

[lcaoi]

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.