Eduardo Engemann
-
Total de itens
10 -
Registro em
-
Última visita
Posts postados por Eduardo Engemann
-
-
Pessoal to com um big de um problema e gostaria de pedir encarecidamente a ajuda.
O problema é o seginte:
Tenho uma tabela (DataBase) e nela contém um campo (HoraCadastro com tipo de dados Hora/data), que será armazenada a hora atual que vira do formulário de cadastro de usuários (o nome do formulário é “GERAL - CADASTRO DE USUÁRIOS) e neste formulário tenho uma caixa de texto com nome de TxTHoraAtual e em propriedades na fonte de controle tenho =Tempo().
Em propriedades do formulário em EVENTO intem intervalo do crnometro coloquei 1000 e No Timer tenho o seguinte procedimento:
Private Sub Form_Timer()
strEspacos = strEspacos + " "
strCaption = strEspacos + strTexto
intEspacos = Len(strEspacos)
intTexto = Len(strTexto)
Me.Form.Caption = strCaption
intCaption = intEspacos + intTexto
If intCaption = 50 Then
strEspacos = ""
End If
Me.Form.Repaint
Me.TxTHoraAtual.Requery
End Sub
Quando executo o formulario neste campo aparece a hora e rodando um relógio.
E tenho um botão que salva os registros preenchidos na tabeala Data Base, e queria saber qual procedimento que terei que escrever para savalar a hora atual que aprace neste formulário na tabela (processo descrito anteriormente).
Neste botão tenho o seguinte procedimento ao clicar:
Private Sub Comando16_Click()
If IsNull([LOGON]) Then
MsgBox "Você não digitou o usuário!", vbExclamation, "AVISO!"
LOGON.SetFocus
ElseIf senha <> Me.Texto4 Then
MsgBox "Confirmação de senha não coincide com a senha!", vbCritical, "AVISO!"
LOGON.SetFocus
Else
MsgBox "USUÁRIO CADASTRADO COM SUCESSO!", vbExclamation, "AVISO!"
DoCmd.Close
End If
End Sub
Agradeço atenciosamente a todos que me ajudarem.
e-mail para contato eduardo.engemann@gmail.com
Eduardo Engemann
-
Caros amigos tenho em uma formulario 2 combo box (caixa de combinação)
mas antes vamos com calma.
As tabela que tenho são as seguintes
TB_Cadastro_Médiuns
Matmediun (chave primaria)
NomeMediun
Endereco
Telefone
TB_Trab_Mediunicos
CodTrabMediunico (Chave Primaria) NomeTrabMediunico
LocalTrabMediunico
DiaSemanaTrabMediunico
Tab_Trab_Mediunico_Mediun
MatMediun (chave Primaria)
CodTrabMediunico (chave Primaria)
As duas primeira tablas estão rlacinada com a terceira pela chaves primarias.
Em um formulario o qual chamo de Cadstro de Trabalhos Mediunicos tem dois combo Box:
Um combo box tem MatMédium e NomeMedium, ao selecionala aparece o nome do medium, que vem da tabela Tab_Cad_Mediuns (mostra 2 colunas),
Desse combo box só sera armazenado a MatMedium na Tab_Trab_Mediunicos
SELECT TB_Cad_Mediuns.NomeMedium, TB_Cad_Mediuns.MatMedium
FROM TB_Cad_Mediuns
ORDER BY TB_Cad_Mediuns.NomeMedium;
Em outro combo box tenho CodTrabmediunico , NomeTrabMediunico,LocalTrabMediunico e DiaSemanaTrabMediunico ( 4 colunas), desse combo box sera armazenado o CodTrabMediunico na tabela Tab_Trab_Mediunico.
SELECT TB_Trab_Mediunicos.CodTrabMediunico, TB_Trab_Mediunicos.NomeTrabMediunico, TB_Trab_Mediunicos.LocalTrabMediunico, TB_Trab_Mediunicos.DiaSemanatrabMediunico
FROM TB_Trab_Mediunicos
ORDER BY TB_Trab_Mediunicos.NomeTrabMediunico;
Esse armazamento ocorrera, apos selecionado os intes em ambos combo box, e no formuladrio tem alguns botões um e SALVAR REGISTRO é ne quando clicado sera feito o armazenamento na tabela Tab_Trab_Mediunicos, e tem um outro botão que é para gerar uma novo processo de seleção e armazenamento. e um botão que fecha o formulario
Não tem nenhuma guia, seta de deslocamento , linha divisori, abas tudo isso ta desativado, e quando o formulario se abre gostaria de que não aparecesse nenhuma informação de incio nos combo box e também quando clicase em novo.
Agradeço desde já a ajuda daqule me socorrorem
Eduardo Martins Engemann
Desculpem mas gostaria de ter inserido as figuras que demostram melhor toda a estrutura do banco de dados e dessa parate se alguém souber como ou quiser ralmente me ajudar me envie seu e-mail e lhe mando o arqivo doc com as figuras e texto acima ok
Fiquem com Deus
-
Caro Leandro Abbade
Caro amigo mais ou menos já dei uma andada nesse caso, descobri que ao colocar na tabela no campo HoraAtula nas propriedades do campo com Valor Padrão Tempo(), e depois inserindo este memo campo no formulario Cadastro ao executar o formulario aparece no campo a hora altual mas ela não esta indexando, na propriedades do formulario tenho:
HoraCadastro - É o campo onde aparece a hora no formulario ( é a hora atual) , não esta indexando ou seja os segundo não rodam.
Napropriedade do formulario no item Intervalo do Cronometro está 1000
Tenho os seguintes procedimento dentro do formulario:
____________________________________________________________
Option Compare Database
Dim strTexto As String
Dim strEspacos As String
Dim strCaption As String
Dim intTexto As Integer
Dim intEspacos As Integer
Dim intCaption As Integer
_____________________________________________________________
Private Sub Comando9_Click()
Dim T As Recordset, D As Database
Set D = CurrentDb
Set T = D.OpenRecordset("SENHA", dbOpenDynaset)
While T.EOF = False
If LOGON = T!LOGON And senha = T!senha Then
MsgBox "SENHA CONFIRMADA!", vbInformation, "AVISO !"
DoCmd.OpenForm "MENU PRINCIPAL"
Me.Visible = False
Exit Sub
Else
T.MoveNext
End If
Wend
MsgBox "LOGON OU SENHA INCORRETOS!", vbCritical, "AVISO !"
End Sub
Private Sub Comando6_Click()
If senha <> Texto4 Then
MsgBox "Confirmação não confere com a senha!", vbCritical, "AVISO!"
Me.Undo
Else
MsgBox "SENHA ALTERADA/CADASTRADA COM SUCESSO!", vbExclamation, "AVISO!"
End If
End Sub
______________________________________________________________________________________________
Private Sub Comando23_Click()
On Error GoTo Err_Comando23_Click
DoCmd.GoToRecord , , acNewRec
Exit_Comando23_Click:
Exit Sub
Err_Comando23_Click:
MsgBox Err.Description
Resume Exit_Comando23_Click
End Sub
___________________________________________________________________________________________
Private Sub Comando16_Click()
If IsNull([LOGON]) Then
MsgBox "Você não digitou o usuário!", vbExclamation, "AVISO!"
LOGON.SetFocus
ElseIf senha <> Me.Texto4 Then
MsgBox "Confirmação de senha não coincide com a senha!", vbCritical, "AVISO!"
LOGON.SetFocus
Else
MsgBox "USUÁRIO CADASTRADO COM SUCESSO!", vbExclamation, "AVISO!"
DoCmd.Close
End If
End Sub
_____________________________________________________________________________________
Private Sub Comando25_Click()
Me.Undo
DoCmd.Close
End Sub
_____________________________________________________________________________________
Private Sub Comando60_Click()
DoCmd.RunMacro "GERAL - USUÁRIOS"
End Sub
Private Sub Form_Open(Cancel As Integer)
senha.Enabled = False
Texto4.Enabled = False
End Sub
________________________________________________________________________________________
Private Sub Form_Timer()
strEspacos = strEspacos + " "
strCaption = strEspacos + strTexto
intEspacos = Len(strEspacos)
intTexto = Len(strTexto)
Me.Form.Caption = strCaption
intCaption = intEspacos + intTexto
If intCaption = 50 Then
strEspacos = ""
End If
Me.Form.Repaint
Me.HoraCadastro.Requery
End Sub
________________________________________________________________
Private Sub LOGON_AfterUpdate()
Dim achacodigo
cod = LOGON
achacodigo = DLookup("[usuário]", "DataBase", "[cod]=[usuário]")
If LOGON = (achacodigo) Then
MsgBox "Já existe um usuário com esse login cadastrado!", vbCritical, " Erro"
senha.Enabled = False
Texto4.Enabled = False
LOGON.SetFocus
Else
senha.Enabled = True
Texto4.Enabled = True
End If
End Sub
_______________________________________________________________________________________________
Private Sub senha_AfterUpdate()
Dim achacodigo
cod = senha
achacodigo = DLookup("[senhad]", "DataBase", "[cod]=[senhad]")
If senha = (achacodigo) Then
MsgBox "Já existe uma senha igual cadastrada, por favor tente outra!", vbCritical, " Erro"
LOGON.Enabled = False
Texto4.Enabled = False
senha.SetFocus
Else
LOGON.Enabled = True
Texto4.Enabled = True
End If
End Sub
Ficarei Grato no que puder me ajudar desde já lhe agradeço vossa atenção e a de quem mais estiver a disposição.
Um Grande abraço Eduardo Engemann
e-mail: eduardo.engemann@gmail.com
-
Caro Leandro Abbade
Não entedi, mas deicha eu explicar novamente o que to querendo, para ver se nos entendemos
Tenho uma tabela de nome Cadastro e nela um cam de DataAtual ( que já aconsegui fazer com que armazene a data atual, vinda do formulario cadastro que mostra automaticamente essa data, e quando dou para salvar o conteudo do formulario ela é salva) ok.
e tenho um outro campo na mesma tabela cadastro chamado Hora Atual, que sera para armazenar a hora de quando aquele registro feito no formulario Cadastro foi armazenado ou feito o cadastro:
Exemplificando:
No formuario tenho Nome (Campo para digirar o nome que esta lincado com a tabela cadastro); capo Data Atual ( não se digita ela mostra a data no qual na tabela no campo DataAtual e esta em valor padrão data(), e quando no formulario mando salvar ela salva adata em que esse cadastro (registro) foi realizado, e tem um campo Hora Atual no Formulario que me mosta a hora atual que devera mostrar a hora atual e quando for armazenado o registro ele armazena a hora atual em que foi salvo no capo da tambela HoraAtual
Tenho um form que tem um campo de texto com o nome txtTempo e dentro dele aparece =Tempo() & " - " & Data()
e tenho esses procedimentos
Private Sub Form_Timer()
strEspacos = strEspacos + " "
strCaption = strEspacos + strTexto
intEspacos = Len(strEspacos)
intTexto = Len(strTexto)
Me.Form.Caption = strCaption
intCaption = intEspacos + intTexto
If intCaption = 50 Then
strEspacos = ""
End If
Me.Form.Repaint
Me.txtTempo.Requery
End Sub
Aqui esta todo os procedimentos desse formulario
Option Compare Database
Dim strTexto As String
Dim strEspacos As String
Dim strCaption As String
Dim intTexto As Integer
Dim intEspacos As Integer
Dim intCaption As Integer
Public Function Cumprimento()
Dim strMsg As String
If Time < #12:00:00 PM# Then
strMsg = "Ola! Tenha um bom dia!"
ElseIf Time <= #6:00:00 PM# Then
strMsg = "Ola! Tenha uma boa tarde!"
Else
strMsg = "Ola! Tenha uma boa noite!"
End If
Cumprimento = strMsg
End Function
Private Sub Comando16_LostFocus()
Dim vOk As Integer
vOk = MsgBox(" Tem certeza que deseja encerrar o programa?", vbYesNo + vbQuestion, "Saída")
If vOk = vbYes Then
End
End If
End Sub
Private Sub Comando9_Click()
Dim acesso As Recordset
Dim DB As Database
Set DB = CurrentDb
Set acesso = DB.OpenRecordset("ACESSOS")
Dim T As Recordset, D As Database
Set D = CurrentDb
Set T = D.OpenRecordset("tbusuarios", dbOpenDynaset)
While T.EOF = False
If LOGON = T!usuário And SenhaDigitada = T!Senhad Then
Me.Visible = False
DoCmd.OpenForm "Frm_Inicialização"
Me!ACESSOUSUARIO = LOGON
Me!ACESSODATA = Date
Me!ACESSOHORA = Time
acesso.AddNew
acesso![usuario] = Me!ACESSOUSUARIO
acesso![Data] = Me!ACESSODATA
acesso![hora] = Me!ACESSOHORA
acesso.Update
Exit Sub
Else
T.MoveNext
End If
Wend
MsgBox "Usuário ou senha incorretos!", vbCritical, "AVISO !"
LOGON.SetFocus
SenhaDigitada.Visible = False
cada.Visible = False
cadf.Visible = True
SenhaDigitada.Value = Null
If IsNull([Nível]) Then
MsgBox "O nível para esse usuário precisa ser cadastrado!", vbCritical, "Erro"
LOGON.Value = Null
SenhaDigitada.Value = Null
LOGON.SetFocus
End If
End Sub
Private Sub senha_AfterUpdate()
If senha = senha Then
End Sub
Private Sub Fechar_Click()
DoCmd.Quit
End Sub
Private Sub Form_Open(Cancel As Integer)
Comando9.Enabled = False
cada.Visible = False
cadf.Visible = True
strTexto = "FEIC CADASTRO DE MÉDIUNS e TRABALHOS MEDIÚNICOS"
strEspacos = ""
Me.TimerInterval = 500
End Sub
Private Sub Form_Timer()
strEspacos = strEspacos + " "
strCaption = strEspacos + strTexto
intEspacos = Len(strEspacos)
intTexto = Len(strTexto)
Me.Form.Caption = strCaption
intCaption = intEspacos + intTexto
If intCaption = 50 Then
strEspacos = ""
End If
Me.Form.Repaint
Me.txtTempo.Requery
End Sub
Private Sub LOGON_AfterUpdate()
Dim achacodigo
cod = LOGON
achacodigo = DLookup("[usuário]", "tbusuarios", "[cod]=usuário")
If IsNull(achacodigo) Then
MsgBox "Este usuário não existe!", vbCritical, " Erro"
LOGON.Value = Null
LOGON.SetFocus
SenhaDigitada.Visible = False
Comando9.Enabled = False
SenhaDigitada.Value = Null
Else
DoCmd.ApplyFilter , "[usuário]=[Forms]![frmlogin].[cod]"
SenhaDigitada.Visible = True
SenhaDigitada.SetFocus
cada.Visible = True
cadf.Visible = False
Comando9.Enabled = True
End If
End Sub
Private Sub SenhaDigitada_LostFocus()
Dim acesso As Recordset
Dim DB As Database
Set DB = CurrentDb
Set acesso = DB.OpenRecordset("ACESSOS")
Dim T As Recordset, D As Database
Set D = CurrentDb
Set T = D.OpenRecordset("tbusuarios", dbOpenDynaset)
While T.EOF = False
If LOGON = T!usuário And SenhaDigitada = T!Senhad Then
Me.Visible = False
DoCmd.OpenForm "Frm_Inicialização"
Me!ACESSOUSUARIO = LOGON
Me!ACESSODATA = Date
Me!ACESSOHORA = Time
acesso.AddNew
acesso![usuario] = Me!ACESSOUSUARIO
acesso![Data] = Me!ACESSODATA
acesso![hora] = Me!ACESSOHORA
acesso.Update
Exit Sub
Else
T.MoveNext
End If
Wend
MsgBox "Usuário ou senha incorretos!", vbCritical, "AVISO !"
LOGON.SetFocus
SenhaDigitada.Visible = False
cada.Visible = False
cadf.Visible = True
SenhaDigitada.Value = Null
If IsNull([Nível]) Then
MsgBox "O nível para esse usuário precisa ser cadastrado!", vbCritical, "Erro"
LOGON.Value = Null
SenhaDigitada.Value = Null
LOGON.SetFocus
End If
End Sub
Se puder me ajudar com isso fico grato desde já , um forte abraço e fique com Deus
Abraços Eduardo Engemann
e-mail:
eduardo.engemann@gmail.com
-
Caros amigos tenho uma tabela de cadastro e ela esta licada au fomulario de cadastro For_Cadastro e a tabela Usuarios, e bem nesse formulario gostaria que aparecese automaticamente a Data atual e em outro campo a Hora atual, e depos fossem armazenados respectivamente na tabela Usuarios nos seguintes campos DataCadastro e HoraCadastro, que aparecerá automaticamente no formulario de cadastro (Form_Cadastro) e rodando, marcando automaticamente as horas minutos e segundos, e quando desse o comando de salvar os dados ali colocados armazenassem a Data Atual e a Hora naquele momento, a data já consegui fazer mas a hora não consegui nada na internet que me desse ajuda se alguém tiver alguma dica simples não muito complicada e facial de entender pois sou meio leigo no assunto me desse a dica bem explica ficarei muito grato.
Desde já agradeço aos que aqui vierem me ajudar, fiquem com Deus
Obrigadooooooooooooooo
Eduardo Engemann
podem mandar sugestões e exemplos para o meu e-mail: eduardo.engemann@gmail.com
-
Caros amigos to usando uma exemplo para meu bd e to modifanco ela e agora gostaria de modificar um barra já pronta , já consegui modifica seu nome e agora quero modificar seu conteudo os nomes como fazer , ele tem um modoulo que se chama modBarra, seu codigo é o seguinte:
Option Compare Database
Option Explicit
'*******************************************************************
'* Inicio *
'*******************************************************************
'DESENVOLVIDO POR SÉRGYO ROBERTO DA SILVA
'EMAIL: sergyors@bol.com.br
Function ocbars()
On Error GoTo Err_ocbars
'oculta barras de ferramentas padrão do access
DoCmd.ShowToolbar "Menu Bar", acToolbarNo
CommandBars("Database").Visible = False
Exit_ocbars:
Exit Function
Err_ocbars:
MsgBox "Contate o administrador do sistema", vbCritical, "BARRASDEMENU"
DoCmd.Quit
Resume Exit_ocbars
End Function
Function libbars()
On Error GoTo Err_libbars
'mostra barras de ferramentas padrão do access
DoCmd.ShowToolbar "Menu Bar", acToolbarYes
CommandBars("Database").Visible = True
Exit_libbars:
Exit Function
Err_libbars:
MsgBox "Contate o administrador do sistema", vbCritical, "BARRASDEMENU"
DoCmd.Quit
Resume Exit_libbars
End Function
Function barsform()
On Error GoTo Err_barsform
'mostra barras de ferramentas para formularios
DoCmd.ShowToolbar "BarIni", acToolbarNo
DoCmd.ShowToolbar "BarMenu", acToolbarNo
DoCmd.ShowToolbar "BarForm", acToolbarYes
Exit_barsform:
Exit Function
Err_barsform:
MsgBox "Contate o administrador do sistema", vbCritical, "BARRASDEMENU"
DoCmd.Quit
Resume Exit_barsform
End Function
Function barsmain()
On Error GoTo Err_barsmain
'mostra barras de ferramentas para menu principal
DoCmd.ShowToolbar "MDTrabCadastroFEIC", acToolbarYes
Exit_barsmain:
Exit Function
Err_barsmain:
MsgBox "Contate o administrador do sistema", vbCritical, "MDTrabCadastroFEIC"
DoCmd.Quit
Resume Exit_barsmain
End Function
Function barsini()
On Error GoTo Err_barsini
'mostra barras de ferramentas para inicial e login
DoCmd.ShowToolbar "BarIni", acToolbarYes
DoCmd.ShowToolbar "BarForm", acToolbarNo
DoCmd.ShowToolbar "BarMenu", acToolbarNo
Exit_barsini:
Exit Function
Err_barsini:
MsgBox "Contate o administrador do sistema", vbCritical, "BARRASDEMENU"
DoCmd.Quit
Resume Exit_barsini
End Function
Function nobars()
On Error GoTo Err_nobars
'oculta todas as barras
DoCmd.ShowToolbar "MDTrabCadastroFEIC", acToolbarNo
CommandBars("Database").Visible = False
DoCmd.ShowToolbar "SRLogin", acToolbarNo
Exit_nobars:
Exit Function
Err_nobars:
MsgBox "Contate o administrador do sistema", vbCritical, "SRLogin"
DoCmd.Quit
Resume Exit_nobars
End Function
Function ajustaform()
On Error GoTo Err_ajustaform
' ajusta form na tela
DoCmd.Restore
DoCmd.MoveSize 270, 0, 11650, 7390
Exit_ajustaform:
Exit Function
Err_ajustaform:
MsgBox Err.Description
Resume Exit_ajustaform
End Function
'*******************************************************************
'* Fim *
'*******************************************************************
o exmplo ta no seguinte link:
http://www.4shared.com/document/vLNqzyQc/SR_LOGIN_II.html
arquivo de texto com informaçoes relevantes o bd:
http://www.4shared.com/document/JMRRyjrs/LEIA-ME.html
desdeja agradeço aos que vem me dando conselhos e ajuda, fico grato.
que Deus esteja com vocês meus amigos
e-mail para contato e enviar soluções e resposta: eduardo.engemann@gmail.com
Umforte abraço
-
Pessoal to usondo um BD como base para criar um outro banco e to modificando para adequalo ao que preciso, mas to tendo problemamas no formulario de login.
O problema e quando logo ele não ta armazenando as informações corretas, to enviando link para vere o que acontece e me socorrerem também tem outro problemas que ao manipularem perceberam.
Estou fazendo moficações nele e to tendo alguns problemas :
o primeiro e mais importante é quando logo, com o formulario de login (form_Login), determinadas informações deverão ser armazenadas na tabela de acessos (Tb_Acessos), que vem depois de confirmar a o log e os dados vem da tabela de Usuarios (Tb_Usuários), no formulario de log in tem um procedimento de consulta que você podera ver em propriedades do formulario acho que ali esta o problema pois e tipo uma consulta.
O segundo e quando coloco o login e a senha correta ele confirma com uma mensagem e não esta abrindo o próximo formulario que seria o Administrador(Form_Administrador).
Preciso de uma solução o mais breve possivel
Link
http://www.4shared.com/dir/36085368/30400856/sharing.html
Desde já agradeço aquem puder me ajudar
e-mail: eduardo.engemann@gmail.com
-
Pessoal descobri o negócio é que ocultaram uma boa parte do sistem mas já resolvi.
Como fazer parqa anexar um arquivo aqui não to sabendo achar??????
-
Caroa amigo tenho um BD que baichei de exemplo para ver o funcionamento de login mas to percebendo e tendo dificuldades de entende-lo pos em se form de onde encontra o login ele consulta um tabela atraves de cosulta em uma tabela inexistente como isso é possivel eu exportei para o meu bd que to criando e tadando erro quando abro a tal consulta pelas propriedades do formulario o conteudo da tabela sumiu desapareceu exite algumamaneira de fazer com que o access crie essa tabela fantasma fisicamente?
Foto em Relatório
em Access
Postado
Caros amigos
to com um outro problema em meu Banco de dados, tenho uma tabela (Database) com um campo Localfoto), neste fica armazenado o camonho onde as fotos inseridas através do formulario cadastro, no formulario todo esta ocorrendo normalmente, mas o problema e ao gerar o relatório não to conseguindo fazer as fotos aparecerem já tentei o seguinte e não esta funcionando não sei porque.
1 no Relatório inseri um Objeto Imagem, com o nome Foto2
2 Na seção detalhes dete relatório priedade na aba eventos na opção Ao Formatar inseri o seguinte código:
Private Sub Detalhe_Format(Cancel As Integer, FormatCount As Integer)
Me!Foto2.Picture = Me!Localfoto
End Sub
Foto2 - Objeto Imagem que aparece a foto
Localfoto - campo da tabela Database onde o caminho da foto esta armazenada
Mas ao abrir ou executar o formulario da erro e tarja de amarelo o código acima
Alguém por favor poderia me ajudar já visitei uma porção de sites foruns e nada de nadicas consigo implementar e fazer a foto aparecer.
Ela sera amazenada em diversos formatos o codigo de inserir a fóto é o seguinte:
Dim strCaminho As String, strPastaInicial As String
strPastaInicial = "C:\Meus Documentos"
strCaminho = Buscar(Me.hWnd, "Inserir foto", strPastaInicial, _
"Arquivos gráficos (*.bmp; *.gif; *.jpg)" & vbNullChar & "*.bmp; *.gif; *.jpg")
If Len(strCaminho) > 0 Then
Me.Localfoto = strCaminho
Me.Foto.Picture = Me.Localfoto
End If
Foto - Objeto Imagem que aparece a foto
Localfoto - campo da tabela Database onde o caminho da foto esta armazenada
E tenho um procedimento em Modulo de nome Localizar o neúdo é o seguinte:
Option Compare Database
Public Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustomFilter 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
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_PATHMUSTEXIST = &H800
Const cTAMANHO = 11
Public Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String) As Long
Public Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Public Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Function Buscar(lngHwnd As Long, strTítulo As String, strPastaInicial As String, strFiltro As String) As String
Dim filebox As OPENFILENAME
Dim result As Long
With filebox
.lStructSize = Len(filebox)
.hwndOwner = lngHwnd
.hInstance = 0
.lpstrFilter = strFiltro & vbNullChar & _
"Todos os Arquivos (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar
.nMaxCustomFilter = 0
.nFilterIndex = 1
.lpstrFile = Space(256) & vbNullChar
.nMaxFile = Len(.lpstrFile)
.lpstrFileTitle = Space(256) & vbNullChar
.nMaxFileTitle = Len(.lpstrFileTitle)
.lpstrInitialDir = strPastaInicial & vbNullChar
.lpstrTitle = strTítulo & vbNullChar
.flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY
.nFileOffset = 0
.nFileExtension = 0
.lCustData = 0
.lpfnHook = 0
End With
result = GetOpenFileName(filebox)
If result <> 0 Then
Buscar = Left(filebox.lpstrFile, InStr(filebox.lpstrFile, vbNullChar) - 1)
Else
Buscar = ""
End If
End Function
Obrigaado a todos que puderem me dar uma solução e me ajudarem.
Fiquem com Deus.
Eduardo Engemann
contato: eduardo.engemann@gmail.com