MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Verifica se ficheiro Excel está aberto

    Compartilhe

    maluco_sergio
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 37
    Registrado : 09/11/2016

    Verifica se ficheiro Excel está aberto

    Mensagem  maluco_sergio em 2/2/2018, 20:30

    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
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5489
    Registrado : 15/03/2013

    Re: Verifica se ficheiro Excel está aberto

    Mensagem  ahteixeira em 3/2/2018, 12:07

    Olá Filipes Lopes,

    Veja se é isso:
    [Você precisa estar registrado e conectado para ver este link.]

    Abraço

    maluco_sergio
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 37
    Registrado : 09/11/2016

    Re: Verifica se ficheiro Excel está aberto

    Mensagem  maluco_sergio em 15/2/2018, 19:34

    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
    avatar
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5489
    Registrado : 15/03/2013

    Re: Verifica se ficheiro Excel está aberto

    Mensagem  ahteixeira em 22/2/2018, 00:27

    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

      Data/hora atual: 25/9/2018, 20:29