ERROR: 'FileName.xlsm' is open in another application. Please close it and try again.

[Hawk11ns]

The following code is erroring out at set excelWorkbook = excelApp.Workbooks.Open(filePath). I believe it is because I am loading an excel file as a Datasource and then trying to open the same file again later and edit/copy information from a sheet. How can I get around this error?

Sub OrigisServicesReporting()

Dim filePath As String

Dim excelApp As Excel.Application
Dim excelWorkbook As Excel.Workbook
Dim excelWorksheet As Excel.Worksheet

Dim wordDoc As Document
Dim rngFind As Range
Dim rngReplace As Range

Dim masterDoc As Document
Dim singleDoc As Document
Dim lastRecordNum As Integer

'prompt user to select the monthly excel file
Application.ScreenUpdating = False
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
  .Title = "Select Excel Data Source File"
  .AllowMultiSelect = False
  .Filters.Add "Documents", "*.xls; *.xlsx; *.xlsm", 1
  .InitialFileName = ""
  If .Show = -1 Then
    filePath = .SelectedItems(1)
  Else
    GoTo ErrExit
  End If
End With
With ActiveDocument.MailMerge
  .OpenDataSource Name:=filePath, ReadOnly:=True, AddToRecentFiles:=False, _
    LinkToSource:=False, Connection:="Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" & _
    "Data Source=filePath;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
    SQLStatement:="SELECT * FROM `MERGE$`", SQLStatement1:="", SubType:= _
        wdMergeSubTypeAccess
End With
ErrExit:
Application.ScreenUpdating = True

' Open the Excel file and select the appropriate worksheet
Set excelApp = New Excel.Application
[COLOR=rgb(247, 218, 100)]Set excelWorkbook = excelApp.Workbooks.Open(filePath)[/COLOR]

'MailMerge to DOC/PDF
Dialogs(wdDialogMailMergeRecipients).Display TimeOut:=1
Set masterDoc = ActiveDocument
   
    'Record 1
    masterDoc.MailMerge.DataSource.ActiveRecord = 1
    
    masterDoc.MailMerge.Destination = wdSendToNewDocument
    masterDoc.MailMerge.DataSource.FirstRecord = masterDoc.MailMerge.DataSource.ActiveRecord
    masterDoc.MailMerge.DataSource.LastRecord = masterDoc.MailMerge.DataSource.ActiveRecord
    masterDoc.MailMerge.Execute False
    
    Set singleDoc = ActiveDocument
    
    ' Change cell A1 to AZ1
    Set excelWorksheet = excelWorkbook.Sheets("R")
    excelWorksheet.Range("C1").Value = "AZ1"
    excelWorksheet.Range("T2:AD25").Copy
            
    ' Find and replace the word "TEST" with the copied cells as a picture
    Set wordDoc = ActiveDocument
    Set rngFind = wordDoc.Content
    With rngFind.Find
        .Text = ">LOSS_TABLE<"
        Do While .Execute
            ' Select the text to be replaced
            Set rngReplace = wordDoc.Range(rngFind.Start, rngFind.End)
            ' Replace the text with the copied cells as a picture
            rngReplace.Select
            Selection.PasteSpecial DataType:=wdPasteMetafilePicture
        Loop
    End With
           
    singleDoc.SaveAs2 _
            FileName:=masterDoc.MailMerge.DataSource.DataFields("DocFolderPath").Value & Application.PathSeparator & _
                masterDoc.MailMerge.DataSource.DataFields("DocFileName").Value & ".docx", _
            FileFormat:=wdFormatXMLDocument
       
        singleDoc.Close False

' Close the Excel file
    excelWorkbook.Close SaveChanges:=False
    excelApp.Quit
    
End Sub

 

[Hawk11ns]

This has been resolved on my end. For reference, the solution was to set the opening of the same file being used as a datasource as Read Only:

Set excelWorkbook = excelApp.Workbooks.Open(filePath, ReadOnly:=True)