[Resolvido]Veriricar se existe o mesmo arquivo em execução antes de abrir

Bom dia caros amigos
Estou qui mais uma vez pedido um reforço

Dias a tráz solicitei o código para nosso amigo JPaulo sobre como abrir um doc com senha pelo BD.
Eis o cógigo abaixo e funcionando.

Public Function fncAbrirArquivoWord(nomeArquivo As String)
'Marque a Referencia VBA Microsoft Word 11.0 Object Library, ou a 12.0 para o Ms Access 2007
Dim Word As New Word.Application
With Word
.Documents.Open nomeArquivo, , , , "password", "password"
.Visible = True
.WindowState = wdWindowStateMaximize
End With
End Function

Meu problema agora é quando o usuário executa o arquivo já aberto (instancia aberta)
Isso causo um grave problema (trava o BD)

Como poderia complementar o código acima para verificar se já existe algum arquivo em execução e bloquear sua abertura ou avisar o operador?

no aguardo

Mostra algum número de erro?

Não.....

Ele abre o arquivo normalmente "como somente leitura", e trava BD e o Doc

Teste com as alterações em vermelho:

Public Function fncAbrirArquivoWord(nomeArquivo As String)
On Error Goto TrataErro
'Marque a Referencia VBA Microsoft Word 11.0 Object Library, ou a 12.0 para o Ms Access 2007
Dim Word As New Word.Application
With Word
.Documents.Open nomeArquivo, , , , "password", "password"
.Visible = True
.WindowState = wdWindowStateMaximize
End With

TrataErro:
MsgBox"Houve um erro. Provavelmente o arquivo já foi aberto", vbInformation, "Erro"
Resume Next
End Function

David

Já fiz este teste (tratamento de erro)
Veja bem.....não é um erro do access ao abrir a aplicação...

Ele abre normalmente porem como já possui um arquivo logado ele reabre como somente leitura.
Isso é normal na abertura de arquivo de mesmo nome.doc. Porem como estou executando pelo access ele e o bd trava.

Por isso a ideia de não deixar abrir quando a aplicação já encontrase ativa (em execusão ou minimizada).

Aguardo suas ponderações.

Quando você abre o domunto word, ele cria um
arquivo. Qual é o nome do arquivo que aparece?

Não cria um novo

simplismente abre o mesmo arquivo:

ex: modelo.doc
e apos executar o codigo novamente abre modelo.doc (somente leitura)

aí trava o BD

at.

Com mais uma função, resolve;



Public Function fncAbrirArquivoWord(nomeArquivo As String)
'Marque a Referencia VBA Microsoft Word 11.0 Object Library, ou a 12.0 para o Ms Access 2007
Dim Word As New Word.Application
If Not VerificaWordAberto(nomeArquivo) Then
With Word
.Documents.Open nomeArquivo, , , , "password", "password"
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Else
MsgBox "Documento encontra-se aberto, aguarde...", vbCritical
Exit Function
End If
End Function

Public Function VerificaWordAberto(strFicheiro As String)
Dim intFicheiro As Long
Dim intErro As Long

On Error Resume Next
intFicheiro = FreeFile()
Open strFicheiro For Input Lock Read As #intFicheiro
Close intFicheiro
intErro = Err
On Error GoTo 0

Select Case intErro
Case 0: VerificaWordAberto = False
Case 70: VerificaWordAberto = True
Case Else: Error intErro
End Select
End Function

Estou acompanhando essa solução, muito interessante para quem gosta de mala direta no Word, utilizo uma macro nos Doc's que executo com o BD ao mandar abrir um arquivo doc, essa macro ajuda na conecção com o BD, quem sabe se ela for melhorada pode informar ao BD que o DOC esta aberto e com isso cancelar a abertura.

VBA do access: parte da rotina de abrir um doc
stAppNameDOC = "WinWord.exe" & " /mConectar " & origem 'Executa uma Macro chamada Conectar
Call Shell(stAppNameDOC, 1)
SendKeys "S" 'aciona a tecla S do teclado p confirmar Sim na conecção.

VBA do doc:
Sub Conectar()
On Error Resume Next
'conectar dados do BD
If ActiveDocument.MailMerge.State = WdMailMergeState.wdNormalDocument Then
'Isto verifica se o documento não é um documento de mala direta
MsgBox "Macro executada pelo Banco de Dados, documento sem mala direta...", vbInformation, "Sem dados!"
'Certificar-se de que o documento é um doc principal com uma fonte de dados anexada.
If ActiveDocument.MailMerge.State = WdMailMergeState.wdMainAndDataSource Then
MsgBox "Documento já foi vinculado...", vbInformation, "Dados conectados!"
Else
MsgBox "Abrindo assistente de conecção de dados...", vbInformation, "Conectar dados!"
ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\BD_Inscricoes\Inscrição\FrontEnd.accdb", ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\BD_Inscricoes\Inscrição\FrontEnd.mdb;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLED" _
, SQLStatement:="SELECT * FROM `_Dados_Aluno`", SQLStatement1:="", SubType _
:=wdMergeSubTypeAccess
End If
Else
'Certificar-se de que o documento é um doc principal com uma fonte de dados anexada.
If ActiveDocument.MailMerge.State = WdMailMergeState.wdMainAndDataSource Then
MsgBox "Documento já foi vinculado...", vbInformation, "Dados conectados!"
Else
MsgBox "Abrindo assistente de conecção de dados...", vbInformation, "Conectar dados!"
ActiveDocument.MailMerge.OpenDataSource Name:= _
"C:\BD_Inscricoes\Inscrição\FrontEnd.accdb", ConfirmConversions:=False, _
ReadOnly:=False, LinkToSource:=True, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", WritePasswordDocument:="", _
WritePasswordTemplate:="", Revert:=False, Format:=wdOpenFormatAuto, _
Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\BD_Inscricoes\Inscrição\FrontEnd.mdb;Mode=Read;Extended Properties="""";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=5;Jet OLEDB:Database Locking Mode=0;Jet OLED" _
, SQLStatement:="SELECT * FROM `_Dados_Aluno`", SQLStatement1:="", SubType _
:=wdMergeSubTypeAccess
End If
End If

End Sub


Sou robbista, frequento sites para estudo, aprendi muito com mestre Avelido do usandoaccess e tenho um ex. de BD q fiz: http://sic.iniciantejoomla.com/

Sou mais Brasil!

Bom dia Caro JPaulo

com a agregação desta função parou de funcionar a abertura do arquivo (que estava de acordo).

Tratei o erro e aparece o seguinte:

Erro 53
Arquivo não localizado.

Se tiro a função "VerificaWordAberto(strFicheiro As String)" abre normalmente.

O que pode estar errado?

at.

Eu fiz o teste aqui e deu certinho.

Posso fazer aqui um exemplo para lhe mostrar o caminho das pedras.

Copie o ficheiro de word para c:\

Faça o teste pressionando o botão do form, quando abrir o word minimize e volte a pressionar o botão do form.

Abre word com password e não deixa abrir novamente se já aberto:

https://dl.dropbox.com/u/771097/MarceloSilva.rar

Atenção às referencias VBA, eu setei a 12.0 para o Access 2007, deve ou devem alterar para a vossa versão.

JPaulo

Fiz o teste com seu exemplo e deu certo, porem quando edito o diretório aparesenta o mesmo erro:
ou seja, se o ficheiro estiver em uma pasta ele dá o erro:

O diretório está certo pois fiz o teste abortando a função de verificar se há algum arquivo aberto e aí abre normalmente.


abaixo está minha formula
abaixo em vermelho está a direção /pasta do arquivo.doc

_____________________________________________________________________

Public Function fncAbrirWord(nomeArquivo As String)
'Marque a Referencia VBA Microsoft Word 11.0 Object Library, ou a 12.0 para o Ms Access 2007
Dim Word As New Word.Application
If Not VerificaWordAberto(nomeArquivo) Then
With Word
.Documents.Open "C:\BaseTCE\ProgTCE\" & nomeArquivo, , , , "123", "123"
.visible = True
.WindowState = wdWindowStateMaximize
End With
Else
MsgBox "Documento encontra-se aberto, aguarde...", vbCritical
Exit Function
End If
End Function

Certissimo, assim dá erro, porque você não informou que estava numa subpasta.

Tem de alterar a linha de validação;

If Not VerificaWordAberto("C:\BaseTCE\ProgTCE\" & nomeArquivo) Then

Ficará assim;



Private Sub SeuBotão_Click()
Call fncAbrirArquivoWord("Teste.doc")
End Sub


Public Function fncAbrirArquivoWord(nomeArquivo As String)
'Marque a Referencia VBA Microsoft Word 11.0 Object Library, ou a 12.0 para o Ms Access 2007
Dim Word As New Word.Application
If Not VerificaWordAberto("C:\BaseTCE\ProgTCE\" & nomeArquivo) Then
With Word
.Documents.Open "C:\BaseTCE\ProgTCE\" & nomeArquivo, , , , "123", "123"
.Visible = True
.WindowState = wdWindowStateMaximize
End With
Else
MsgBox "Documento encontra-se aberto, aguarde...", vbCritical
Exit Function
End If
End Function


Public Function VerificaWordAberto(strFicheiro As String)
Dim intFicheiro As Long
Dim intErro As Long

On Error Resume Next
intFicheiro = FreeFile()
Open strFicheiro For Input Lock Read As #intFicheiro
Close intFicheiro
intErro = Err
On Error GoTo 0

Select Case intErro
Case 0: VerificaWordAberto = False
Case 70: VerificaWordAberto = True
Case Else: Error intErro
End Select
End Function

ok .....

Certinho

Funcionou Perfeitamente....
Obrigado mestre JPaulo

at.

Valew pelo retorno, abraço.

Gostei muito de acompanhar essa solução, parabéns... ficou perfeito... vou imprementar mais esse conhecimento...

Sou mais Brasil!

Valew, é para isso mesmo que o fórum existe.