Excel 2007 VBA - Duplicate file error

[shoreteknow]

I am generating a workbook in 2007 (customer requirements, not mine) and have the following code which generates a separate workbook (and emails it) with a subset of the data in the current worksheet:

Private Sub Mail_DataOnly()
    On Error GoTo Catch
    'https://msdn.microsoft.com/en-us/library/office/aa203718(v=office.11).aspx#odc_mailtheselection
    'http://www.techonthenet.com/excel/macros/email_sheet2007.php
    'http://stackoverflow.com/questions/20212582/copy-range-from-one-sheet-to-another-vba
    'http://www.mrexcel.com/forum/excel-questions/62596-macro-before-send-mail.html
    'http://www.mrexcel.com/forum/excel-questions/399630-copy-header-footer-another-sheet-visual-basic-applications.html
    
    Dim dg As VbMsgBoxResult
    dg = MsgBox("Are you sure you want to Email this report?", vbYesNo, "EMail Prompt")
    
    If dg = vbNo Or dg = vbCancel Then GoTo ExitSub
    
    'Create a new worksheet with only the active range of data within it as well as the header and footer visible.
    Dim LBook As Workbook
    Dim LFileName As String
    
    'Need to finalize the range piece
    Dim Source As Range
    Dim SubjAttachString As String
    SubjAttachString = Range("B9").Cells(0)
       
    'Remove "Task" if it exists in the string
    If Len(RTrim(SubjAttachString)) = 0 Then
        GoTo ExitSub
    ElseIf Left(LTrim(SubjAttachString), 4) = "Task" Then
        SubjAttachString = LTrim(Mid(SubjAttachString, 5, Len(SubjAttachString)))
    End If
    
    'Disable the screen from updating
    Application.ScreenUpdating = False
    
    'Select rows and Copy data to the new worksheet
    Worksheets(1).Activate
    Set Source = Range("A11:" & Split(Cells(, Me.UsedRange.Columns.Count).Address, "$")(1) & CStr(Me.UsedRange.Rows.Count))
    
    If Source Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protect, please correct and try again.", vbOKOnly
        GoTo ExitSub
    End If
    
    'add worksheet to the workbook and insert data
    Set LBook = Workbooks.Add(xlWBATWorksheet)
    Source.Copy
    LBook.Sheets(1).Paste
    
    'copy the header and footer to the new sheet
    With Sheets("Sheet1").PageSetup
        .LeftHeader = LBook.Sheets("Sheet1").PageSetup.LeftHeader
        .CenterHeader = LBook.Sheets("Sheet1").PageSetup.CenterHeader
        .RightHeader = LBook.Sheets("Sheet1").PageSetup.RightHeader
        .LeftFooter = LBook.Sheets("Sheet1").PageSetup.LeftFooter
        .CenterFooter = LBook.Sheets("Sheet1").PageSetup.CenterFooter
        .RightFooter = LBook.Sheets("Sheet1").PageSetup.RightFooter
    End With
     
    'Make sure the file does not already exist
    If Dir(Me.Application.DefaultFilePath & "\" & SubjAttachString & ".xlsx") <> "" Then
        Kill Me.Application.DefaultFilePath & "\" & SubjAttachString & ".xlsx"
    End If
    
    'save worksheet under new workbook
    LBook.SaveAs Filename:=SubjAttachString & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    LFileName = LBook.FullName
    LBook.ChangeFileAccess (xlReadOnly)
    
    'email the new workbook/sheet with custom title & Subject
    LBook.SendMail "", SubjAttachString
    
    LBook.Close
    Set LBook = Nothing
    
    'delete temp workbook
    If Dir(LFileName) <> "" Then
        Kill LFileName 
    End If
    
    Application.ScreenUpdating = True
ExitSub:
    Exit Sub
Catch:
    MsgBox "Error caught during email process: " & Err.Number & " " & Err.Description, vbOKOnly, "Error Caught"
    GoTo ExitSub
End Sub

What is happening is at the SaveAs Line I am getting the following error:

Microsoft Office Excel cannot access the file 'C:\Program Files (x86)\Microsoft Office\Office12\CAC0A000'. There are several possible reasons:

• The file name or path does not exist.
• The file is being used by another program.
• The workbook you are trying to save has the same name as a currently open workbook.

This happens after I create 1 file. I have to then close the entire workbook and then re-open it to do any more. Can anybody provide assistance??

Thanks in advance!

 

[shoreteknow]

Issue has been resolved. I explicity defined the path using Application.DefaultPath - see below:

    'generate the filename
    LFileName = Me.Application.DefaultFilePath & "\" & SubjAttachString & ".xlsx"
    
    'save worksheet under new workbook
    LBook.SaveAs Filename:=LFileName, FileFormat:=xlOpenXMLWorkbook, AccessMode:=xlShared