[Resolvido]Instalar sistema após abrir o form pela primeira vez.

Amigos, tenho um form que depende do Editor de Imagens IrFanView, caso não esteja instalado e com um diretório criado dentro dessa past gera erro na abertura do form.

Ao abrir criarei uma função que verificará o status de uma tabela: tblSistemasDependentes, onde haverá dois campos:
Campo1 = Nome do Sistema (texto)
Campo2 = Status da instalação (Sim/Não)

Onde na primeira execução terá como Status = Não, assim sendo emitirá MsgBox ao usuário requerendo autorização para instalá-lo.
Caso positivo executará a instalação do sistema que estará em um sub-diretório do sistema Access
Em seguida execua a criação de uma pasta dentro da pasta do IrfanView em Arquivos de programas.
Depois atualizo o status para sim, para que na próxima abertura não emita mais a mensagem.

Pergunto:

Como executar essa instalação através do VBA.
Posso utilizar o ShellExecute, mas seria necessário encerrar o form ou o access quando da instalação?

Eis protótipo do Código que estou fazendo.

Private Sub Form_Open(Cancel As Integer)
If DLookup("Instalado", "tblSistemasDependentes", "SistemaDependente = 'IrFanView'") = 0 Then
    Me.VerificaInstalacao
Else
End If
End Sub

Sub VerificaInstalacao()
Dim Instala As String
Dim nArquivo As String

Instala = MsgBox("È necessário a instalação do IrfanView antes de" _
        & vbNewLine & "inicar este módulo." _
        & vbNewLine & "" _
        & vbNewLine & "Deseja instalar o aplicativo?", vbYesNo, "INSTALAÇÃO DO IrFanView")
Select Case Instala
    Case vbYes
        nArquivo = CurrentProject.Path & "\SistemasDependentes" & "iview433_setup.exe"
        Call ShellExecute(0, vbNullString, nArquivo, vbNullString, vbNullString, 1)
        CurrentDb.Execute "UPDATE tblSistemasDependentes set Instalado =1 WHERE SistemaDependente='IrFanView'"
'       DoCmd.Close acForm, Me
    Case vbNo
        DoCmd.Close acForm, Me
End Select
End Sub

Toda ideia é bem vinda.

Grato.

Pesquise a função AppActivate no VBA e veja se ela serve.

Boas Criquio.. irei pesquisar..

Tem um exemplo que postei no repositorio de edição de imagens no Access, que utiliza comando do IrfanView conjugado em seus códigos e são dependentes do mesmo.

Então ao abrir o form caso não esteja instalado, emite mensagem, instala e conjutamente adiciona 3 pastas dentro do Diretório do irfanView na pasta Arquivos de programas, e dentro destas 3 jpg temporário..

Sabe por acaso de algum comando que cria um jpg em branco?


Cumprimentos.

Não seria mais simples criar três arquivos jpg pequenos e deixar junto à instalação?

Ja fiz.. e utilizei o FileCopy...

Depois posto o código completo.

Abraços.

Eis a rotina completa


'---------------------------------------------------------------------------------------
' Procedure : Form_Open
' Author : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum : Fórum Máximo Access - http://maximoaccess.forumeiros.com/
' Date : 19/1/2013
' Comentários : Form Open, verifica a instalação do IrFanView
'---------------------------------------------------------------------------------------
Private Sub Form_Open(Cancel As Integer)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo TrataErro
Dim NomeProcedimento As String
NomeProcedimento = "Form_Open"
'Adiciona o nome do procedimento à função
PegaProcedimento (NomeProcedimento)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim fso, Pasta, Ficheiro, Arquivo
'Verifica se a tblSistemasDependentes está com o status de instalado=Sim para o IrFanView
'Caso esteja marcado como não, executa a rotina VerificaInstalacao
If DLookup("Instalado", "tblSistemasDependentes", "SistemaDependente = 'IrFanView'") = 0 Then
Me.VerificaInstalacao
'Se na rotina VerificaInstalacao a variável Cancela estiver setada como true, emite mensagem e encerra o frm
If Cancela = True Then MsgBox "Este Aplicativo não pode ser inicializado" _
& vbNewLine & "Sem a instalação do IrfanView", vbInformation, "ENCERRANDO": Cancel = True: Exit Sub
Else
'Verifica se na pasta do IrFanView existe os arquivos .Jpg temporários necessários ao frm
Set fso = CreateObject("Scripting.FileSystemObject")
Set Pasta = fso.GetFolder("C:\Arquivos de programas\IrfanView")
'Busca pelo primeiro arquivo (de 3) na pasta do irfanView
For Each Ficheiro In Pasta.Files
'Caso encontre o arquivo encerra a sub
If Ficheiro = Pasta & "\TempPic1.jpg" Then
Exit Sub
End If
Next
'Caso não seja encontrado o arquivo, significa que os mesmos não existem na pasta
'Seta na tblSistemasDependentes o campo ArquivoCopiado para não e executa a rotina de cópia
'Isto é necessário caso o irFanView tenha sido desinstalado
CurrentDb.Execute "UPDATE tblSistemasDependentes set ArquivoCopiado = 0 WHERE SistemaDependente='IrFanView'"
Me.CopiaArquivos
End If
Exit Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub
TrataErro:
Select Case err.Number
Case 76
CurrentDb.Execute "UPDATE tblSistemasDependentes set Instalado = 0 WHERE SistemaDependente='IrFanView'"
Cancel = True
Cancela = True
MsgBox "Este Aplicativo não pode ser inicializado" _
& vbNewLine & "Sem a instalação do IrfanView", vbInformation, "ENCERRANDO": Cancel = True
Case 2498
CurrentDb.Execute "UPDATE tblSistemasDependentes set Instalado = 0 WHERE SistemaDependente='IrFanView'"
Cancela = True
MsgBox "Este Aplicativo não pode ser inicializado" _
& vbNewLine & "Sem a instalação do IrfanView", vbInformation, "ENCERRANDO": Cancel = True
Case Else
DoCmd.Hourglass False
DoCmd.Echo True
'Chama a função global de tratamento de erros
GlobalErrHandler (Me.Name)
End Select
End Sub

'---------------------------------------------------------------------------------------
' Procedure : VerificaInstalacao
' Author : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum : Fórum Máximo Access - http://maximoaccess.forumeiros.com/
' Date : 19/1/2013
' Comentários : Rotina para instalação do IrFanView
'---------------------------------------------------------------------------------------
Sub VerificaInstalacao()
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo TrataErro
Dim NomeProcedimento As String
NomeProcedimento = "VerificaInstalacao"
'Adiciona o nome do procedimento à função
PegaProcedimento (NomeProcedimento)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim Instala As String
Dim nArquivo As String

'MsgBox para aviso que é necessário a instalação do IrFanView para abri este formulário
Instala = MsgBox("È necessário a instalação do IrfanView antes de" _
& vbNewLine & "inicar este módulo." _
& vbNewLine & "" _
& vbNewLine & "Deseja instalar o aplicativo?", vbYesNo, "INSTALAÇÃO DO IrFanView")
'Case da mensagem
Select Case Instala
'Caso afirmativo, executa rotina de instalaçao fechando o frm e abrindo a instalação do IrFanView
Case vbYes
nArquivo = CurrentProject.Path & "\SistemasDependentes" & "iview433_setup.exe"
Call ShellExecute(0, vbNullString, nArquivo, vbNullString, vbNullString, 1)
CurrentDb.Execute "UPDATE tblSistemasDependentes set Instalado =1 WHERE SistemaDependente='IrFanView'"
DoCmd.Close acForm, Me.Name
'Caso negativo marca a variável Cancela como True para encerrar o sistema
Case vbNo
Cancela = True
End Select
Exit Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub
TrataErro:
Select Case err.Number
Case 0
'Não é um erro
Case Else
DoCmd.Hourglass False
DoCmd.Echo True
'Chama a função global de tratamento de erros
GlobalErrHandler (Me.Name)
End Select
End Sub

'---------------------------------------------------------------------------------------
' Procedure : CopiaArquivos
' Author : Harysohn P. Pina (PILOTO) - Harysohn@hotmail.com
' Fórum : Fórum Máximo Access - http://maximoaccess.forumeiros.com/
' Date : 19/1/2013
' Comentários : Rotina para cópia dos .Jpg na pasta do IrFanView
'---------------------------------------------------------------------------------------
Sub CopiaArquivos()
Dim X As Integer
'Checa se o campoArquivoCopiado na tblSistemasDependentes está setado como sim, caso não executa rotina de Cópia
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
On Error GoTo TrataErro
Dim NomeProcedimento As String
NomeProcedimento = "CopiaArquivos"
'Adiciona o nome do procedimento à função
PegaProcedimento (NomeProcedimento)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If DLookup("ArquivoCopiado", "tblSistemasDependentes", "SistemaDependente = 'IrFanView'") = 0 Then
For X = 1 To 3
PastaDestino = "C:\Arquivos de programas\IrfanView" & "TempPic" & X & ".jpg"
PastaOrigem = CurrentProject.Path & "\SistemasDependentes\TempPic" & X & ".jpg"
FileCopy PastaOrigem, PastaDestino
Next X
'Tendo sido copiado os três aquivos .Jpg, seta o campo CopiadoArquivos para sim na tblSistemasDependentes
CurrentDb.Execute "UPDATE tblSistemasDependentes set ArquivoCopiado =1 WHERE SistemaDependente='IrFanView'"
End If
Exit Sub
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'Tratamento de Erros
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Exit_TrataErro:
DoCmd.Hourglass False
DoCmd.Echo True
Exit Sub
TrataErro:
Select Case err.Number
Case 0
'Não é um erro
Case Else
DoCmd.Hourglass False
DoCmd.Echo True
'Chama a função global de tratamento de erros
GlobalErrHandler (Me.Name)
End Select
End Sub


Cumprimentos.

Tá certo mestre dos magos