Outlook attachment not reflecting the last change made in the sheets

[Guinaba]

Hi all,

My macro is closing all the sheets before attaching the file in Outlook email. I can see that is happening when the macro ends, keeping only the Summary tab opened.

However, when I check the attachemt in the email I can still see the other sheets opened.

Any idea why is that happening? Am I missing cleaning temporary memory?

Specific VBA code block:

Dim ws As Worksheet 'Close all worksheets except "Summary"
          For Each ws In CurrWkWB.Worksheets
             If ws.Name <> "Summary" Then ws.Visible = xlSheetHidden
          Next ws
           
          'Att. file **THIS WEEK**
        
         .Attachments.Add FileCurrWk
         
          Application.ScreenUpdating = True
          Unload UserForm1
          CurrWkWB.Close SaveChanges:=True
          Set ol = Nothing
          Application.Quit

Complete VBA code:

Sub CreateEmailTUE() 'This sub will prepare the emails including the att. files from last week (final) and this week (MON)

  Dim ol As Outlook.Application
  Dim mi As Outlook.MailItem
  Dim doc As Word.Document
  Dim MsgTxt As String
  Dim RowRng As Range
  Set RowRng = Sheets("Email").Range("c3:c45").Rows
  Dim LastRow As Integer
  LastRow = Last(1, RowRng)
  'NextWk = FWkNum(Date) + 1 'Converting from 2 to 1 charact.
  CurrWk = FWkNum(Date) + 0 'Converting from 2 to 1 charact.
  
  Dim FilePath As String
  'Dim FileNextWk As String
  Dim FileCurrWk As String
  
  FilePath = "S:\Everyone\Demand Planning\Primary & VE\Wow Daily Tracker\"
  FileCurrWk = FilePath & "WTD Sales VS Demand Tracker_W" & CurrWk & "_" & WeekdayName(Weekday(Date), True, vbSunday) & ".XLSM"
    
    
  Set ol = New Outlook.Application
  Set mi = ol.CreateItem(olMailItem)
  
  With mi
          'We can have display or send
           .Display
           
         'To field **Getting the email from the Outlook sheet**
           Dim xRg As Range
           Dim xCell As Range
           Dim xEmailAddr As String
           Dim lRow As Long
           lRow = Worksheets("Outlook").Cells(Worksheets("Outlook").Rows.Count, "B").End(xlUp).Row
           
           Set xRg = Worksheets("Outlook").Range("B2:B" & lRow)
        
        
           For Each xCell In xRg
               If xCell.Value Like "*@*" Then
                  If xEmailAddr = "" Then
                     xEmailAddr = xCell.Value
                Else
                     xEmailAddr = xEmailAddr & ";" & xCell.Value
                  End If
               End If
            Next
              
           .To = xEmailAddr
           
           'Subject
           .Subject = "Woolworths Meat & Deli P&VE Chicken, Turkey & OPP Tracker - " _
            & WeekdayName(Weekday(Date), False, vbSunday) & " " & _
            Format(Date, "dd/MMM/YY", vbUseSystemDayOfWeek)
            
          
          Set doc = mi.GetInspector.WordEditor 'getting the word editor to write in the email's body the sequence here is from bottom to top
          
        '  MsgTxt = vbNewLine & vbNewLine & "Kind Regards"
        '  doc.Range(0, 0).InsertAfter MsgTxt
          
            '*********************************************************Curr Week****************************************************
          
          Dim CurrWkArr1 As Range, CurrWkArr2 As Range, CurrWkArr3 As Range, CurrWkArr4 As Range, CurrWkArr5 As Range
          Dim CurrWkWB As Workbook
          Set CurrWkWB = Workbooks("WTD Sales VS Demand Tracker_W" & CurrWk & "_" & WeekdayName(Weekday(Date), True, vbSunday) & ".XLSM")
          CurrWkWB.Activate
            
          'Find the last used row in a Column AX, sheet Outlook
          Dim Outlook_LR As Long
          With Worksheets("Outlook")
                Outlook_LR = .Cells(.Rows.Count, "AX").End(xlUp).Row
          End With
            
          'New skus
          If IsEmpty(CurrWkWB.Worksheets("Outlook").Range("Y23")) = False Then
             Set CurrWkArr4 = CurrWkWB.Worksheets("Outlook").Range("Y21:AX" & Outlook_LR)
             CurrWkArr4.Copy
             doc.Range(1, 1).Paste
             doc.Range.InsertParagraphBefore
             
            MsgTxt = vbNewLine & vbNewLine & ChrW(&HD83D) & ChrW(&HDC14) & " New Lines: "
            doc.Range(0, 0).InsertAfter MsgTxt
          End If
          
         'Find the last used row in a Column M, sheet EmailFormat
          Dim CurrWkWB_EmailFormat_LR As Long
          With Worksheets("EmailFormat")
                CurrWkWB_EmailFormat_LR = .Cells(.Rows.Count, "M").End(xlUp).Row
          End With
          
          Set CurrWkArr3 = CurrWkWB.Worksheets("EmailFormat").Range("C2:N" & CurrWkWB_EmailFormat_LR).SpecialCells(xlCellTypeVisible) 'Current week's file
          CurrWkArr3.Copy 'Summary about top skus above or below DP
          doc.Range(1, 1).Paste
          doc.Range.InsertParagraphBefore
           
          Set CurrWkArr2 = CurrWkWB.Worksheets("Outlook").Range("N9:W13") 'End of Week Prediction - Sales + TPRP (tons)
          CurrWkArr2.Copy
          doc.Range(1, 1).Paste
          doc.Range.InsertParagraphBefore
            
          Set CurrWkArr1 = CurrWkWB.Worksheets("Outlook").Range("d5:k7") 'Projected Performance VS Demand
          CurrWkArr1.Copy 'Total Demand Plan by Primary Cut (tons)
          doc.Range(1, 1).Paste
          doc.Range.InsertParagraphBefore
          
          Set CurrWkArr5 = CurrWkWB.Worksheets("Outlook").Range("d19") 'Diff from previous day
          CurrWkArr5.Copy
          MsgTxt = vbNewLine & CurrWkArr5 & vbNewLine
          doc.Range(1, 1).InsertAfter MsgTxt
          
          MsgTxt = vbNewLine & ChrW(&HD83D) & ChrW(&HDC14) & " This Week: "
          doc.Range(0, 0).InsertAfter MsgTxt
          
          MsgTxt = "Hi all," & vbNewLine & vbNewLine & "Woolworths tracker(s) attached. Note - all Demand Plan numbers" _
          & " quoted are Sun to Sat, whereas TPRP is Mon to Sun" & vbNewLine & vbNewLine
        
          doc.Range.InsertBefore Text:=MsgTxt
          
             
          Dim ws As Worksheet 'Close all worksheets except "Summary"
          For Each ws In CurrWkWB.Worksheets
             If ws.Name <> "Summary" Then ws.Visible = xlSheetHidden
          Next ws
           
          'Att. file **THIS WEEK**
        
         .Attachments.Add FileCurrWk
         
          Application.ScreenUpdating = True
          Unload UserForm1
          CurrWkWB.Close SaveChanges:=True
          Set ol = Nothing
          Application.Quit
    
  End With
  

  
End Sub

Function Last(choice As Long, Rng As Range) 'This function get the last row in the sheet using Find method
'Ron de Bruin, 5 May 2008
' 1 = last row
' 2 = last column
    Dim lrw As Long
    Dim lCol As Long

    Select Case choice

    Case 1:
        On Error Resume Next
        Last = Rng.Find(What:="*", _
                        After:=Rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlValues, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
        On Error GoTo 0

    Case 2:
        On Error Resume Next
        Last = Rng.Find(What:="*", _
                        After:=Rng.Cells(1), _
                        Lookat:=xlPart, _
                        LookIn:=xlValues, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        On Error GoTo 0
  End Select
End Function

Function FWkNum(InputDate As Variant) As Variant 'This function get the financial week for a respective date


   Dim lRow As Long
   Dim Vlkup As Variant
   lRow = Sheets("FinCal").Cells(Rows.Count, 4).End(xlUp).Row
   Dim VlkWkStart As Range
   Set VlkWkStart = Sheets("FinCal").Range("d2:E" & lRow)
   Dim FirstDayWk As Variant
   FirstDayWk = InputDate - Weekday(InputDate, vbUseSystem)
   Dim Arr()
   Arr = VlkWkStart
   
   Dim LengthFirstDayWk As Long
   LengthFirstDayWk = Len(FirstDayWk) 'Using this to determine if the right function get 1 or 2 charact.
      
   If LengthFirstDayWk = 10 Then
      Vlkup = Application.VLookup(Format(FirstDayWk, "dd/mm/yyyy"), Arr, 2, 0)
      FWkNum = Right(Vlkup, 2)
   Else
      Vlkup = Application.VLookup(Format(FirstDayWk, "d/mm/yyyy"), Arr, 2, 0)
      FWkNum = Right(Vlkup, 2)
   End If
   
   Erase Arr
   
End Function

Function IsWorkBookOpen(xCheck As String) As Boolean

    Dim xWb As Workbook
    On Error Resume Next
    Set xWb = Application.Workbooks.Item(Name)
    IsWorkBookOpen = (xWb Is Nothing)
    
End Function

 

[6StringJazzer]

After you hide the sheets, you have to save the file before you attach it.

          For Each ws In CurrWkWB.Worksheets
             If ws.Name <> "Summary" Then ws.Visible = xlSheetHidden
          Next ws
          
          CurrWkWB.Save

          'Att. file **THIS WEEK**
       
         .Attachments.Add FileCurrWk

 

[6StringJazzer]

BTW you should set up a string variable with the file name and use it everywhere instead of duplicating the same code

Dim FileName As String
FileName = "WTD Sales VS Demand Tracker_W" & CurrWk & "_" & WeekdayName(Weekday(Date), True, vbSunday) & ".XLSM"
FileCurrWk = FilePath & FileName
Set CurrWkWB = Workbooks(FileName)

 

[Guinaba]

After you hide the sheets, you have to save the file before you attach it.

          For Each ws In CurrWkWB.Worksheets
             If ws.Name <> "Summary" Then ws.Visible = xlSheetHidden
          Next ws
         
          CurrWkWB.Save

          'Att. file **THIS WEEK**
      
         .Attachments.Add FileCurrWk

Awesome! Simple solution! Thanks a lot @6StringJazzer