Macro Runs Manually but not Automatically

Joined
Apr 13, 2007
Messages
1
Reaction score
0
This is the first time I've ever written or run a macro in Outlook. Every day, I receive an e-mail with an attachment from a particular sender. That e-mail is automatically moved to a subfolder in my Inbox using Rules. I'm trying to create a macro that will take that unread e-mail, download the attachment to two places on the network, and then mark the e-mail as read. The macro runs fine when I run it manually. However, nothing happens when I have the macro running in the background. I'm puzzled as to why this is. Is there something I'm missing? (FYI, I have my security level set at Medium.)

Here's the code that I put in the ThisOutlookSession module:

---------------------
Option Explicit

Sub SaveAttachmentsToFolder()
' This Outlook macro checks a particular subfolder in the Inbox
' for any unread messages and saves the attachment from each message to disk.
On Error GoTo SaveAttachmentsToFolder_err

' Declare variables
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Dim ns As NameSpace
Dim Inbox2 As MAPIFolder
Dim SubFolder3 As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim FileName2 As String
Dim SenderEmailAddress As String
Dim Subject As String

Dim i As Integer

Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)
Set ns = GetNamespace("MAPI")
Set Inbox2 = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder3 = Inbox2.Folders("DC Cookie Files")


i = 0
' Check subfolder for messages and exit if none found
If SubFolder3.Items.Count = 0 Then
Exit Sub
End If

ResumeClickYes 'Turns on ClickYes in separate module (to bypass Security Warnings)

' Check each message for attachments
For Each Item In SubFolder3.Items
If Item.UnRead = True And Left(Item.Subject, 18) = "Cookie Data" And Item.SenderEmailAddress = "(e-mail address removed)" Then
For Each Atmt In Item.Attachments
' Check filename of each attachment and save if it has "csv" extension
If Right(Atmt.FileName, 3) = "csv" Then
FileName = "\\server02\TransferIn\" & Atmt.FileName
Atmt.SaveAsFile FileName
FileName2 = "\\server02\Online\" & Atmt.FileName
Atmt.SaveAsFile FileName2
i = i + 1
End If
Next Atmt

Item.UnRead = False
End If
Next Item

' Send summary message
If i > 0 Then
With objEmail
.To = "(e-mail address removed)"
.Subject = i & " Cookie File(s) Processed"
.Send
End With
Set objEmail = Nothing

Else
Set objEmail = Nothing

End If


' Clear memory
SaveAttachmentsToFolder_exit:
Set objOutlook = Nothing
Set objEmail = Nothing
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Set Inbox2 = Nothing
Set SubFolder3 = Nothing

SuspendClickYes 'Turns off ClickYes

Exit Sub


' When Error Occurs, Send Message
SaveAttachmentsToFolder_err:
With objEmail
.To = "(e-mail address removed)"
.Subject = "Error Occurred with Cookie File Processing"
.Body = "Error Description: " & Err.Description
.Send
End With
Set objEmail = Nothing

Resume SaveAttachmentsToFolder_exit

SuspendClickYes 'Turns off ClickYes
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top