[Resolvido]Modulo de abrir arquivo a partir de caminho

Boa tarde Srs.(as)

Possuo um BD onde eu precisaria anexar um arquivo a cada registro, porém segui o conselho de um amigo e coloquei um modulo que funciona assim, a pessoa clica em um botão "localizar" e que abre uma caixa de dialogo e que em seguida a pessoa seleciona aonde o arquivo esta na rede ou no proprio computador. Caminho que fica salvo em um campo "arquivo".

O meu problema agora é que gostaria que após localizar o caminho a pessoa tivesse a opção de abrir este arquivo selecionado. Assim sem alguém pudesse me ajudar a complementar o modulo abaixo ou me dar outra sugestão, eu agradeceria eternamente.

O modulo que falei segue abaixo:


''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Localizar Arquivos '
' '
' '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit ' Requer que as variáveis sejam declaradas antes de serem usadas.
Option Compare Database ' Usa a ordem do banco de dados em comparações de seqüências.

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Type MSA_OPENFILENAME
' Seqüência de filtro usada para os filtros do diálogo Abrir.
' Usa MSA_CriarSeqüênciaDeFiltro() para criar isso.
' Padrão = Todos os Arquivos, *.*
strFiltro As String
' Filtro inicial a exibir.
' Padrão = 1
lngÍndiceFiltro As Long
' Diretório inicial no qual abrir o diálogo.
' Padrão = Diretório de trabalho atual.
strDirInicial As String
' Nome de arquivo inicial com o qual preencher o diálogo.
' Padrão = "".
strArqInicial As String
strTítuloDoDiálogo As String
' Extensão padrão para anexar ao arquivo se o usuário não especificar uma.
' Padrão = Valores do Sistema (Abrir Arquivo, Salvar Arquivo).
strExtensãoPadrão As String
' Sinalizadores (consulte a lista de constantes) a serem usados.
' Padrão = sem sinalizadores.
lngSinalizadores As Long
' Caminho completo do arquivo escolhido. Quando a caixa de diálogo Arquivo
' Abrir é apresentada e o usuário escolhe um arquivo não existente, somente
' o texto da caixa "Nome do arquivo" é retornado.
strCaminhoCompletoRetornado As String
' Nome do arquivo escolhido.
strNomeDeArquivoRetornado As String
' Deslocamento no caminho completo (strCaminhoCompletoRetornado)
' onde o nome do arquivo (strNomeDeArquivoRetornado) começa.
intDeslocamentoDoArquivo As Integer
' Deslocamento no caminho completo (strCaminhoCompletoRetornado)
' onde começa a extensão do arquivo.
intExtensãoDoArquivo As Integer
End Type

Const ALLFILES = "Todos os arquivos"

Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Function localizarArq(strCaminhoDeLocalização) As String
' Exibe a caixa de diálogo Abrir para que o usuário localize o
' banco de dados BdLab. Retorna o caminho completo para o BdLab.

Dim msaof As MSA_OPENFILENAME

' Define opções para a caixa de diálogo.
msaof.strTítuloDoDiálogo = "Selecione o arquivo."
msaof.strDirInicial = strCaminhoDeLocalização
msaof.strFiltro = MSA_CriarSeqüênciaDeFiltro("JPG", "*.jpg", "JPEG", "*.jpeg", "BMP", "*.bmp", "GIF", "*.gif", "Todos", "*.*")

' Chama a rotina do diálogo Abrir.
MSA_ObterAbrirNomeArq msaof

' Retorna o caminho e o nome de arquivo.
localizarArq = Trim(msaof.strCaminhoCompletoRetornado)

End Function


Function MSA_CriarSeqüênciaDeFiltro(ParamArray varFilt() As Variant) As String
' Cria uma seqüência de filtro a partir dos argumentos passados.
' Retorna "" se nenhum argumento for passado.
' Espera um número par de argumentos (nome do filtro, extensão),
' mas se um número ímpar de argumentos for passado, anexa *.*

Dim strFiltro As String
Dim intRet As Integer
Dim intNúm As Integer

intNúm = UBound(varFilt)
If (intNúm <> -1) Then
For intRet = 0 To intNúm
strFiltro = strFiltro & varFilt(intRet) & vbNullChar
Next
If intNúm Mod 2 = 0 Then
strFiltro = strFiltro & "*.*" & vbNullChar
End If

strFiltro = strFiltro & vbNullChar
Else
strFiltro = ""
End If

MSA_CriarSeqüênciaDeFiltro = strFiltro
End Function

Function MSA_ConverterSeqüênciaDeFiltro(strFiltroEnt As String) As String
' Cria uma seqüência de filtro a partir de uma seqüência separada por barras ("|").
' A seqüência deve consistir em pares filtro|extensão, como "Access Databases|*.mdb|All Files|*.*"
' Se não houver extensões para o último par de filtro, *.* será adicionado.
' Este código ignora quaisquer seqüências vazias, ou seja, pares "||".
' Retorna "" quando a seqüência passada está vazia.


Dim strFiltro As String
Dim intNúm As Integer, intPos As Integer, intÚltPos As Integer

strFiltro = ""
intNúm = 0
intPos = 1
intÚltPos = 1

' Adiciona seqüências enquanto encontra barras.
' Ignora quaisquer seqüências vazias (não admitidas).
Do
intPos = InStr(intÚltPos, strFiltroEnt, "|")
If (intPos > intÚltPos) Then
strFiltro = strFiltro & Mid(strFiltroEnt, intÚltPos, intPos - intÚltPos) & vbNullChar
intNúm = intNúm + 1
intÚltPos = intPos + 1
ElseIf (intPos = intÚltPos) Then
intÚltPos = intPos + 1
End If
Loop Until (intPos = 0)

' Obtém a última seqüência se ela existir (assumindo
' que strFiltroEnt não termina em barra).
intPos = Len(strFiltroEnt)
If (intPos >= intÚltPos) Then
strFiltro = strFiltro & Mid(strFiltroEnt, intÚltPos, intPos - intÚltPos + 1) & vbNullChar
intNúm = intNúm + 1
End If

' Adiciona *.* se não houver extensão para a última seqüência.
If intNúm Mod 2 = 1 Then
strFiltro = strFiltro & "*.*" & vbNullChar
End If

' Adiciona NULL de terminação se temos algum filtro.
If strFiltro <> "" Then
strFiltro = strFiltro & vbNullChar
End If

MSA_ConverterSeqüênciaDeFiltro = strFiltro
End Function

Private Function MSA_ObterSalvarNomeArq(msaof As MSA_OPENFILENAME) As Integer
' Abre o diálogo de salvar arquivo.

Dim of As OPENFILENAME
Dim intRet As Integer

MSAOF_para_OF msaof, of
of.Flags = of.Flags Or OFN_HIDEREADONLY
intRet = GetSaveFileName(of)
If intRet Then
OF_para_MSAOF of, msaof
End If
MSA_ObterSalvarNomeArq = intRet
End Function

Function MSA_SimplesObterSalvarNomeArq() As String
' Abre o diálogo de salvar arquivo com valores padrões.

Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String

intRet = MSA_ObterSalvarNomeArq(msaof)
If intRet Then
strRet = msaof.strCaminhoCompletoRetornado
End If

MSA_SimplesObterSalvarNomeArq = strRet
End Function

Private Function MSA_ObterAbrirNomeArq(msaof As MSA_OPENFILENAME) As Integer
' Abre o diálogo Abrir.

Dim of As OPENFILENAME
Dim intRet As Integer

MSAOF_para_OF msaof, of
intRet = GetOpenFileName(of)
If intRet Then
OF_para_MSAOF of, msaof
End If
MSA_ObterAbrirNomeArq = intRet
End Function

Function MSA_SimplesObterAbrirNomeArq() As String
' Abre o diálogo Abrir com valores padrões.

Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String

intRet = MSA_ObterAbrirNomeArq(msaof)
If intRet Then
strRet = msaof.strCaminhoCompletoRetornado
End If

MSA_SimplesObterAbrirNomeArq = strRet
End Function

Private Sub OF_para_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
' Esta sub converte da estrutura Win32 para a estrutura do Microsoft Access.

msaof.strCaminhoCompletoRetornado = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
msaof.strNomeDeArquivoRetornado = of.lpstrFileTitle
msaof.intDeslocamentoDoArquivo = of.nFileOffset
msaof.intExtensãoDoArquivo = of.nFileExtension
End Sub

Private Sub MSAOF_para_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
' Esta sub converte da estrutura do Microsoft Access para a estrutura Win32.

Dim strArquivo As String * 512

' Inicializa algumas partes da estrutura.
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0

If msaof.strFiltro = "" Then
of.lpstrFilter = MSA_CriarSeqüênciaDeFiltro(ALLFILES)
Else
of.lpstrFilter = msaof.strFiltro
End If
of.nFilterIndex = msaof.lngÍndiceFiltro

of.lpstrFile = msaof.strArqInicial _
& String(512 - Len(msaof.strArqInicial), 0)
of.nMaxFile = 511

of.lpstrFileTitle = String(512, 0)
of.nMaxFileTitle = 511

of.lpstrTitle = msaof.strTítuloDoDiálogo

of.lpstrInitialDir = msaof.strDirInicial

of.lpstrDefExt = msaof.strExtensãoPadrão

of.Flags = msaof.lngSinalizadores

of.lStructSize = Len(of)
End Sub

Utilize o follow hyperlink no clique ou duplo clique do campo

Obrigado Vieira, poderia explicar em qual campo coloco o follow me? e se a expressão a se utilizada é esta mesma?

Perdão, pois estou aprendendo ainda.

Muito obrigado novamente.

Kleyton

Bom dia Vieira

Não consegui fazer funcionar.

Alguem teria alguma ajuda para me dar?

Grato

Você pode tentar o seguinte: crie um módulo e coloque uma função pública nele com o seguinte código:


Option Compare Database

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Agora, coloque um botão para abrir o arquivo e no evento "Ao clicar" do botão, coloque:

Dim strArquivo

strArquivo = NomeDoCampoComOCaminho
Call ShellExecute(0, vbNullString, strArquivo, vbNullString, vbNullString, 1)

Bom dia Criquio,

Valeu novamente pela ajuda cara, vocês estão salvando vidas... heheh

Então não conseguiu fazer funcionar, com a alteração do nome do campo o ao code do botão ficou assim correto?

Private Sub Comando69_Click()
Dim strArquivo
strArquivo = Arquivo
Call ShellExecute(0, vbNullString, strArquivo, vbNullString, vbNullString, 1)
End Sub
Obs.: o nome do campo é arquivo

Muito obrigado novamente

Você criou o módulo com a função passada acima? Quando clica no botão, dá alguma mensagem de erro?

Criquio,

Inverti a frase em azul e até funcionou ele abre, mas após abrir ele apaga o caminho que estava na textbox.

Private Sub Comando69_Click()
Dim strArquivo
Arquivo = strArquivo
Call ShellExecute(0, vbNullString, strArquivo, vbNullString, vbNullString, 1)
End Sub

Quando criei o modulo e o botão com o code igualzinho vc postou... e quando clico no botão ele não faz nada!

Desculpe criqui, refiz o que vc tinha postado e funcionou direitinho.

Valeu mesmo muito obrigado!

Só faltou clicar no botão Resolvido.