(Resolvido) Identificar onde está instalado o programa.

[gjacobis]

Bom dia moçada. B)

Já começo a semana precisando de seus conhecimentos.

Preciso saber de qual unidade o programa está rodando.

Obrigado

[MrMALJ]

Opa pesquisei e achei uma otima forma de fazer isso que você que, vou postar exatamente como está no JR's FAQ...

Veja os três exemplos de código abaixo:

1. A rotina abaixo exibe o Caminho (Path) completo do MDB:

Function GetNamePath()

Dim MyDB As DAO.Database

' Define MyDB como o banco de dados atual.

Set MyDB = DBEngine.Workspaces(0).Databases(0)

GetNamePath = MyDB.Name

End Function

Essa função roda em todas as versões a partir do Access 2.0, contanto que se referencie a biblioteca DAO correspondente no menu Ferramentas - Referências. Por exemplo, use DAO 3.5 para as versões 95 e 97; e DAO 3.6 para a versão 2000.

Para testar o código, abra a Janela Depurar ou Verificação imediata (CTRL+G), digite a expressão abaixo e tecle ENTER:

?GetNamePath()

2. A função abaixo retorna somente o diretório do MDB:

Function ExtraiPasta(caminho As String) As String

'Cortesia de JR - http://www26.brinkster.com/accessjr/

'Retorna a pasta de um arquivo cujo caminho foi informado.

Dim arquivo As String

If Len(caminho) > 0 Then

arquivo = Dir(caminho)

ExtraiPasta = Left(caminho, Len(caminho) - Len(arquivo))

End If

End Function

Ou:

Function ExtraiPasta(caminho As String) As String

'Cortesia de JR - http://www26.brinkster.com/accessjr/

'Retorna a pasta de um arquivo cujo caminho foi informado.

On Error Resume Next

Dim I As Integer, Nome As String

For I = 1 To Len(caminho)

Nome = Right(caminho, I)

If InStr(Nome, "\") Then

ExtraiPasta = StrConv(Left$(caminho, Len(caminho) - Len(Nome)), _

vbProperCase)

Exit For

End If

Next I

If Err <> 0 Then MsgBox Err.Description

End Function

3. A função abaixo retorna somente o nome do arquivo MDB:

Function ExtraiNomeBD(caminho As String) As String

' Desenvolvida por João Rodrigues (JR)

' http://www26.brinkster.com/accessjr/

Dim I As Integer, Nome As String

On Error Resume Next

For I = 1 To Len(caminho)

Nome = Right(caminho, I)

If InStr(Nome, "\") <> 0 Then

ExtraiNomeBD = StrConv(Right(Nome, Len(Nome) - 1), _

vbProperCase)

Exit For

End If

Next I

If Err <> 0 Then MsgBox Err.Description

End Function

Para testá-la, digite o seguinte na janela Depurar e pressione ENTER:

?ExtraiNomeBD("D:\Controle\Licita99.mdb")

O Access irá retornar o nome do arquivo =Licita99.mdb

[gjacobis]

Fera MrMALJ. B)

Excelente, exatamente como eu queria.

Mais uma vez, muito obrigado.