VBA '1004' error at ActiveWorkbook.Save - vba

Question

I have created a VBA module that :
searches for a specific email in outlook
grabs the excel file attachment from the email it finds
formats the excel file attachment (adds colors and grid to make it look more presentable)
saves the formatted excel file to my desktop
sends email(s) to our client with the formatted excel file as an attachment (and pastes the excel file into the body of the email)
** I use multiple arrays to send to individual clients
My code works pretty well and has worked without issues many times. However, every now and again it will have a '1004 run time error' pop up randomly while processing. When I debug, it takes me to 'ActiveWorkbook.Save'. Usually if I run it again it works just fine, but I need it to be more user friendly for others to use. Code is as follows.
Public f As Integer 'format integer
Sub Clients()
'Array([file destination to be saved], [subject of file being searched in outlook], [file name given when saved], [emails the report is going to])
f = 0
email_1 = Array("C:\User\Desktop\", "FL Test Results", "FL_Reports", "client1#email.com")
Call Reports(email_1)
f = 1
email_2 = Array("C:\User\Desktop\", "CA Test Results", "CA_Reports", "client2#email.com")
Call Reports(email_2)
f = 2
email_3 = Array("C:\User\Desktop\", "NY Test Results", "NY_Reports", "client3#email.com")
Call Reports(email_3)
email_4 = Array("C:\User\Desktop\", "TX Test Results", "TX_Reports", "client4#email.com")
Call Reports(email_4)
End Sub
Function Reports(a As Variant)
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim olFldr As MAPIFolder
Dim olItms As Items
Dim olMi As MailItem
Dim olEmail As Outlook.MailItem
Dim olAtt As Attachment
Dim subj As String
Dim saveAs As String
Dim emails As String
Dim FilePath As String
FilePath = a(0)
subj = a(1)
saveAs = a(2)
emails = a(3)
Set olApp = GetObject(, "Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = olFldr.Items
Set olEmail = olApp.CreateItem(olMailItem)
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
Set rng = ActiveSheet.UsedRange
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Set olMi = olItms.Find("[Subject] = " & Chr(34) & subj & Chr(34))
If Not (olMi Is Nothing) Then
For Each olAtt In olMi.Attachments
olAtt.SaveAsFile FilePath & saveAs & ".xls"
Workbooks.Open (FilePath & saveAs & ".xls")
Call format.Run 'Seperate file that formats the raw excel sheet to look more pretty
If f = 0 Then
Call format.DeleteOldClasses 'different ways clients want there excel file info sorted
ElseIf f = 1 Then
Call format.sortByDate
Else
End If
ActiveWorkbook.Save '#######This is where the error pops up
Set rng = Worksheets(saveAs).UsedRange
Next olAtt
End If
On Error Resume Next
With OutMail
.Attachments.Add FilePath & saveAs & ".xls"
.To = emails
.CC = ""
.BCC = ""
.subject = subj
.HTMLBody = RangetoHTML(rng)
.send
End With
On Error GoTo 0
ActiveWorkbook.Close
Kill (FilePath & saveAs & ".xls")
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
Set olAtt = Nothing
Set olMi = Nothing
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Function
Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2013
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook
TempFile = Environ$("temp") & "\" & format(Now, "dd-mm-yy h-mm-ss") & ".htm"
'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.delete
On Error GoTo 0
End With
'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=TempFile, _
Sheet:=TempWB.Sheets(1).Name, _
Source:=TempWB.Sheets(1).UsedRange.Address, _
HtmlType:=xlHtmlStatic)
.Publish (True)
End With
'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.readall
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
"align=left x:publishsource=")
'Close TempWB
TempWB.Close savechanges:=False
'Delete the htm file we used in this function
Kill TempFile
Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
Thank you for your time and help.

Answer 1

So I found a solution that works for me but maybe not others with the same issue. I Set my workbooks as #findwidow and #R3uk suggested. I simply put "On Error Resume Next" and save an extra copy in a new place that I pull the attachment from to place in the email.
On Error Resume Next
wB.Save
wB.SaveCopyAs ("C:\Users\Ken\Desktop\" & saveAs & ".xls")
Set rng = Worksheets(saveAs).UsedRange
Next olAtt
End If
It wont save the formatted excel file at times during the error, however this rarely happens now and it is only for our own documentation. It now continues through the cycle of client arrays with ease (and actually seems faster). Thank you for the help.