Bobby Davison
Bobby Davison

Reputation: 1

Calling Excel from Outlook VBA, Excel wont quit on conclusion

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

Answers (0)

Related Questions