Reputation: 1
First time poster here... An application we use in work bursts out reports/emails to many recipients, often many to one recipient. The email subject and attached XLSX file name are always the same. I have written some Outlook VBA code that will open the email, save the attachment, open the attachment, read the value of a cell, close the attachment and rename the file based on the value in the cell. My problem is that Excel wont quit at the end of the macro because I am using a global reference ("ProjectName"). If I hardcode this field, Excel WILL quit as expected, so I know its the problem..
Similar issue here but I cant work out what to do differently: Excel application not closing from Outlook VBA function
This is my code (anonymised). It has inbuilt pauses
' Declare Sleep Function
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Sub SaveCogAttachments()
Dim MItem As Outlook.MailItem
Dim oAttachment As Outlook.Attachment
Dim SaveFolder As String
Dim SubFolder As String
Dim FullFileName As String
Dim ProjectName As String
Dim LenProjectName As Integer
Dim FullFileNameNew As String
Dim DateTimeNow As String 'Attachment save date
Dim MessageStatus As String
Dim OutlookFolder As Object
Dim oExcel As Object
Dim FileContentName As String
Set oExcel = CreateObject("Excel.Application")
' Set Parameter Values Here
'
SaveFolder = "C:\Temp" ' Location where files are to be saved
MessageStatus = "Unread" ' Unread/All Only, Setting to Unread means only Unread emails will be checked
'
'
MsgBox "About to run the VBA code which saves down the Project Spend Reports to " & SaveFolder & " and renames them based on the Project name within the file. This can take a few minutes to run. The code currently looks for " & MessageStatus & " emails with 'XXXX' in the subject line and received from '[email protected]'. Please press OK to proceed and wait for the completion message. "
' If you want to version control the attachments, rather than overwrite them, use this parameter as part of the target file name
DateTimeNow = Format(Now, "yyyy-mm-dd H-mm")
Set OutlookFolder = Application.ActiveExplorer.CurrentFolder 'Sets Active Folder
' Subfolder set to blank - this means that the SaveFolder is the default folder if no subfolder exists
SubFolder = "\"
ProjectName = ""
For Each MItem In OutlookFolder.Items
If InStr(MItem.Subject, "XXXX") > 0 And InStr(MItem.Sender, "[email protected]) > 0 Then ' ONLY RUN FOR EMAILS WITH THIS IN THE SUBJECT LINE FROM THIS SENDER
If MessageStatus = "Unread" And MItem.UnRead = True Then ' ONLY RUN IF THESE EMAILS ARE UNREAD
' Check each attachment
For Each oAttachment In MItem.Attachments
FullFileName = SaveFolder & SubFolder & DateTimeNow & " - " & oAttachment.DisplayName
' Its not possible to open a file with VBA before saving it
oAttachment.SaveAsFile FullFileName
oExcel.Workbooks.Open (FullFileName)
Sleep (12000) ' 12 seconds pause to ensure the file is successfully opened
' Locate the Project Name in the file
ProjectName = Range("A6").Value
LenProjectName = Len(ProjectName)
' Strip 'Project: ' from Project Name
ProjectName = Right(ProjectName, LenProjectName - 9)
FullFileNameNew = SaveFolder & SubFolder & ProjectName & " - " & DateTimeNow & ".xlsx"
' Close the Workbook
oExcel.Workbooks.Close
Sleep (5000) ' 5 seconds pause to ensure Excel Workbook is closed down, Excel App is still open
' Rename the file
Name FullFileName As FullFileNameNew
Next
Else
' Go to next message
End If
End If
Next
Set oAttachment = Nothing
ProjectName = ""
oExcel.Quit
Set oExcel = Nothing
MsgBox "Macro Completed - Please Check " & SaveFolder & " for the saved files"
Shell "C:\WINDOWS\explorer.exe """ & SaveFolder & "", vbNormalFocus
End Sub
Upvotes: 0
Views: 26