excel remains open in background

[bogdan.goron]

Dear all,

I am kindly asking you to help me with this VBA code. Originally this was created by someone else for Outlook in order to do an export of emails; by combining this code with other ones for excel I obtained the below code. What basically does is to export to an excel file (from the network or from the computer) a list with all the items from a specific Outlook folder and to automatically send emails about this fact. My biggest concern is the fact that an Excel always remains open in the background after executing the code. Do you have any idea on how to optimize this aspect?

Thank you in advance for your help. I really appreciate it.

Sub EMAILS_REPORTING()
 
Set objOLApp = CreateObject("Outlook.Application")
Set objExcel = CreateObject("Excel.Application")
Dim objFolders As Outlook.MAPIFolder
Dim MyInbox As Outlook.Items
Dim objNameSpace As Outlook.NameSpace
Dim objMsg As MailItem
Dim strBody As String
Dim iMeetCount As Integer
Dim intCount As Integer
Dim I As Integer
Dim dtPrevDate As Date
Dim blnDateChanged  As Boolean
Dim FileName As String
Dim LastRow As Integer
 
Set objNameSpace = objOLApp.GetNamespace("MAPI")
Set objFolders = objNameSpace.Folders("aaa.bbb@ccc.com (1)").Folders("Inbox")
 
intCount = objFolders.Items.Count
Set objMsg = Application.CreateItem(olMailItem)
iMeetCount = 0
 
 
dtPrevDate = Date
I = 1
 
If dtPrevDate = DateValue(objFolders.Items(I).CreationTime) Then
iCount = iCount + 1
End If
 
For I = 1 To intCount
iMeetCount = iMeetCount + 1
 
Next
 
 
sFilter = "[ReceivedTime] >= '" & Format(Date - 1, " ddddd 23:59") & "'"
 
Set objItems = objFolders.Items.Restrict(sFilter)
 
 
objExcel.Visible = False
objExcel.Workbooks.Add
 
intZeile = 2
I = 2
 
For Each objItem In objItems
 If objItem.Class = olMail Then
  objExcel.Cells(1, 1) = "SENDER'S NAME"
  objExcel.Cells(I, 1) = objItem.SenderName
  objExcel.Cells(1, 2) = "SENDER'S EMAIL ADDRESS"
  objExcel.Cells(I, 2) = objItem.SenderEmailAddress
  objExcel.Cells(I, 3) = objItem.Subject
  objExcel.Cells(1, 3) = "SUBJECT OF THE EMAIL"
  objExcel.Cells(I, 4) = objItem.ReceivedTime
  objExcel.Cells(1, 4) = "RECEIVED TIME"
  objExcel.Cells(I, 5) = objFolders.FolderPath
  objExcel.Cells(1, 5) = "EMAIL'S PARENT FOLDER"
  objExcel.Cells(1, 7) = "Number of emails for today: "
  objExcel.Cells(2, 7) = "Total number of emails: "
  objExcel.Cells(1, 8) = objFolders.Items.Restrict(sFilter).Count
  objExcel.Cells(2, 8) = iMeetCount
 
 End If
 
I = I + 1
 
  Next
 
    If bRecursive Then
     If objFolder.Folders.Count Then
       objFolders , bRecursive
     End If
   End If
 
For I = 1 To 8
      objExcel.Columns(I).Autofit
      objExcel.Rows(I).Autofit
  Next I
 
On Error Resume Next
On Error GoTo 0
 
Set WBK = objExcel.ActiveWorkbook
 
'Make a copy of the active sheet and save it to a temporary file
 
WBK.SaveAs "C:\Users\XXX\Desktop\Email_Reporting.xlsx"
 
With WBK.Sheets("Sheet1")
 
 EndRngToCopy = .Cells(Rows.Count, "A").End(xlUp).Row
 WBK.Sheets("Sheet1").Range("A2:E" & EndRngToCopy).Select
 
End With
 
objExcel.Workbooks.Open "C:\Users\XXX\Documents\Email_Reportingr.xlsx"
 
With objExcel.ActiveWorkbook.Sheets("ABC")
 
    LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
 
End With
 
WBK.Sheets("Sheet1").Range("A2:E" & EndRngToCopy).Copy Destination:=objExcel.ActiveWorkbook.Sheets("ABC").Range("A" & LastRow + 1)
 
For I = 1 To 5
      objExcel.Columns(I).Autofit
      objExcel.Rows(I).Autofit
  Next I
 
 Set objMsg = Application.CreateItem(olMailItem)
 
 objMsg.To = "aaa.bbb@ccc.com"
    objMsg.CC = "aaa.bbb@ccc.com"
    objMsg.BCC = "aaa.bbb@ccc.com"
    objMsg.Subject = "Count Inbox items"
    objMsg.Attachments.Add "C:\Users\XXX\Desktop\Email_Reporting.xlsx"
    objMsg.Body = strBody & "Hi," & vbCrLf & vbCrLf & "The number of the emails received by me today in my Inbox is " & objFolders.Items.Restrict(sFilter).Count & ". " & "The total number of received and not deleted emails in the Inbox is " & iMeetCount - objFolders.Items.Restrict(sFilter).Count & ". " & vbCrLf & vbCrLf & "Thank you." & vbCrLf & vbCrLf & "ABC" & vbCrLf
    objMsg.Send
 
   Set objMsg = Nothing
   Set objNameSpace = Nothing
   Set objFolders = Nothing
   Set objItems = Nothing
 
'Delete the temporary file
 
   objExcel.ActiveWorkbook.Close SaveChanges:=True
   WBK.Close SaveChanges:=True
   Kill "C:\Users\XXX\Desktop\Email_Reporting.xlsx"
 
 End Sub

 

[Jaafar Tribak]

Are you quiting the created excel instance at the end ?

'Delete the temporary file
 
   objExcel.ActiveWorkbook.Close SaveChanges:=True
   WBK.Close SaveChanges:=True
   Kill "C:\Users\XXX\Desktop\Email_Reporting.xlsx"
   [COLOR=Red][B]objExcel.Quit[/B][/COLOR]

 

[bogdan.goron]

Hi,

I tried what you suggested:

[B][COLOR=Red][B]objExcel.Quit[/B][/COLOR][/B]

but the result seems to be the same. The Excel still runs in background. Any idea on this?

Thank you.