Verifica se ficheiro Excel está aberto

Boa Tarde.
Venho mais uma vez pedir a ajuda do forum para o seguinte:

Uso o código abaixo, que recolhi aqui no forum, para exportar dados de um Form para um ficheiro em Excel.
O código funciona perfeitamente. Contudo, verifico que se o ficheiro já está aberto, devolve um erro.
Queria que ao correr o código primeiro fosse verificado se o ficheiro "oficiar.xlsm" já está aberto. Se estiver, exporta os dados, caso contrário, abre o ficheiro e depois exporta os dados.
Conseguem ajudar-me?

Obrigado

Código:

'ahteixeira 2015 - maximoaccess

Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object

   Set oExcel = CreateObject("Excel.Application")

   Set oBook = oExcel.Workbooks.Open(Application.CurrentProject.Path & "\oficiar.xlsm")
   oExcel.Visible = True

   Set oSheet = oBook.Worksheets(1)

       oSheet.Range("E4").Value = Forms!frmImprimirOficiosSaidasEdit!ID
       oSheet.Range("E3").Value = Forms!frmImprimirOficiosSaidasEdit!NUM
       oSheet.Range("E5").Value = Forms!frmImprimirOficiosSaidasEdit!Entidade
       oSheet.Range("E6").Value = Forms!frmImprimirOficiosSaidasEdit!Morada
       oSheet.Range("E6").Value = Forms!frmImprimirOficiosSaidasEdit!CodPostal
   
   oBook.Save
   oBook.Close
   oExcel.Quit
   MsgBox "Exportação completa. Mude para o ficheiro Excel", vbInformation

Olá Filipes Lopes,

Veja se é isso:
https://www.maximoaccess.com/t5916-resolvidoverificar-aquivo-aberto

Abraço

Olá ahTeixeira

Preciso da sua ajuda. Estou a tentar com o código que me forneceu e não consigo com que funcione.
Como é que posso integrar o código seguinte com o que publicai na minha mensagem anterior? Devo criar uma função no módulo?
Help :-)

Código:

Function ArquivoAberto(strFileName As String) As Boolean
     On Error Resume Next

     ' If the file is already opened by another process,
     ' and the specified type of access is not allowed,
     ' the Open operation fails and an error occurs.
     Open strFileName For Binary Access Read Write Lock Read Write As #1
     Close #1


     ' If an error occurs, the document is currently open.
     If Err.Number <> 0 Then
        ' Display the error number and description.
       ' MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
        FileLocked = True
        Err.Clear
        ArquivoAberto = True
     End If
  End Function

Olá Filipes Lopes,

Sim, deve colocar num Modulo.
Não sei onde quer verificar, veja se é assim que pretende:

Código:

Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object

    If ArquivoAberto(Application.CurrentProject.Path & "\oficiar.xlsm") = True Then
        MsgBox "Ficheiro está aberto.", vbInformation, ""
        Exit Sub
    End If
    
   Set oExcel = CreateObject("Excel.Application")

   Set oBook = oExcel.Workbooks.Open(Application.CurrentProject.Path & "\oficiar.xlsm")
   oExcel.Visible = True

   Set oSheet = oBook.Worksheets(1)

       oSheet.Range("E4").Value = Forms!frmImprimirOficiosSaidasEdit!ID
       oSheet.Range("E3").Value = Forms!frmImprimirOficiosSaidasEdit!NUM
       oSheet.Range("E5").Value = Forms!frmImprimirOficiosSaidasEdit!Entidade
       oSheet.Range("E6").Value = Forms!frmImprimirOficiosSaidasEdit!Morada
       oSheet.Range("E6").Value = Forms!frmImprimirOficiosSaidasEdit!CodPostal
  
   oBook.Save
   oBook.Close
   oExcel.Quit
   MsgBox "Exportação completa. Mude para o ficheiro Excel", vbInformation

Abraço