ABRIR E FECHAR CONEXÃO NO FORMUL?RIO
Gostaria de saber como encaixo nas minhas rotinas para sempre que [ô]abrir conexão[ô] possa [ô]fechar conexão[ô] nos formulários. Por exemplo tenho abaixo a rotina ao abrir formulário, como posso fazer:
Option Explicit
Dim lsql As String
Dim lTBPerfis As Recordset
Dim lItem As ListItem
Dim db As Database [ô]InÃcio das variáveis (3 linhas) referente a [ô]Exclusao[ô] pois tem vinculação entre duas tabelas
Dim rs As Recordset
Dim dbname As String [ô]Fim das variáveis
Private Sub Form_Load()
Caption = [Ô]Perfis - Leader ERP Versão: [Ô] & App.Major & [Ô].[Ô] & App.Minor & [Ô].[Ô] & App.Revision
lblDataFormulario = [Ô] [Ô] & Format(Date, [Ô]dd/mm/yyyy[Ô]) & [Ô] [Ô] [ô]Exibe a data atual ao abrir formulário
RotinaRefresh [ô]Chama rotina para vir com o listview preenchido
[ô]RotinaBloqueioBotaoDireitoMouse [ô]Rotina desabilitada
If retorno = False Then
[ô]MensagemErro [Ô]Ao abrir formulário pesquisa cai aqui dentro![Ô]
Else
[ô]MensagemErro [Ô]Caso contrário cai aqui![Ô]
End If
End Sub
Private Sub RotinaExclusao()
dbname = App.Path & [Ô]\BDSistemaIntegrado.mdb[Ô]
Set db = DBEngine.Workspaces(0).OpenDatabase(dbname)
Dim perfil As Long
If lvwLista.ListItems.Count > 0 Then
perfil = lvwLista.SelectedItem
Set rs = db.OpenRecordset([Ô]SELECT id_Usuario FROM USUARIOS WHERE id_Perfil = [Ô] & perfil)
If rs.RecordCount > 0 Then
MensagemErro [Ô]Perfil já possui vÃnculo com usuários, não é possÃvel excluir![Ô]
txtPerfil.Text = [Ô][Ô]
txtPerfil.SetFocus
Else
MensagemInformativo [Ô]O registro será excluÃdo permanentemente e não poderá ser recuperado.[Ô]
If MsgBox([Ô]Confirma a exclusão do registro Nº [ô][Ô] & lvwLista.SelectedItem & [Ô][ô]?[Ô], vbQuestion + vbYesNo) = vbNo Then
Exit Sub
End If
lsql = [Ô]DELETE FROM PERFIS WHERE id_perfil = [Ô] & lvwLista.SelectedItem
gBDSistemaIntegrado.Execute lsql
lvwLista.ListItems.Remove (lvwLista.SelectedItem.Index)
txtPerfil.Text = [Ô][Ô]
lblContador.Caption = [Ô][Ô]
txtPerfil.SetFocus
RotinaRefresh
End If
End If
End Sub
Private Sub lvwLista_KeyUp(KeyCode As Integer, Shift As Integer) [ô]Rotina para botão delete fazer exclusão de registros
If KeyCode = vbKeyDelete Then
RotinaExclusao [ô]Chama rotina
End If
End Sub [ô]Fim da rotina
Private Sub RotinaNovo()
gsNA = [Ô]N[Ô]
txtPerfil.Text = [Ô][Ô]
frmPerfisNovoAltera.Show , Me
End Sub
Private Sub RotinaAlterar()
dbname = App.Path & [Ô]\BDSistemaIntegrado.mdb[Ô]
Set db = DBEngine.Workspaces(0).OpenDatabase(dbname)
Dim IdPerfil As Long
If lvwLista.ListItems.Count = 0 Then
MensagemErro [Ô]Selecione um registro para fazer a alteração![Ô]
txtPerfil.Text = [Ô][Ô]
txtPerfil.SetFocus
Exit Sub
End If
If lvwLista.ListItems.Count > 0 Then
IdPerfil = lvwLista.SelectedItem
Set rs = db.OpenRecordset([Ô]SELECT id_Usuario FROM USUARIOS WHERE id_Perfil = [Ô] & IdPerfil)
If rs.RecordCount > 0 Then
MensagemErro [Ô]Perfil já possui vÃnculo com usuários, não é possÃvel alterar![Ô]
txtPerfil.Text = [Ô][Ô]
txtPerfil.SetFocus
Exit Sub
End If
End If
txtPerfil.Text = [Ô][Ô] [ô]Rotina para campo ficar em branco
gsNA = [Ô]A[Ô]
frmPerfisNovoAltera.Show , Me
End Sub
Private Sub RotinaExcluir()
If lvwLista.ListItems.Count = 0 Then
MensagemErro [Ô]Selecione um registro para fazer a exclusão![Ô]
txtPerfil.Text = [Ô][Ô]
txtPerfil.SetFocus
Exit Sub
End If
RotinaExclusao [ô]Chama rotina
End Sub
Private Sub RotinaLimpar()
txtPerfil.Text = [Ô][Ô]
txtPerfil.SetFocus
End Sub
Private Sub RotinaSalvar()
MensagemErro [Ô]Opção indisponÃvel![Ô]
End Sub
Private Sub RotinaPesquisar()
If (txtPerfil.Text) <> [Ô][Ô] Then [ô]Monta pesquisa pelos dados informados
lsql = [Ô]SELECT * FROM PERFIS WHERE perfil LIKE [ô]*[Ô] & ComApostrofo(txtPerfil.Text) & [Ô]*[ô][Ô]
Else
lsql = [Ô]SELECT * FROM PERFIS ORDER BY id_perfil ASC[Ô] [ô]Se não for digitado nada retorna todos registros
End If [ô]Fim da rotina
txtPerfil.SetFocus [ô]Foco vai para este campo
Set lTBPerfis = gBDSistemaIntegrado.OpenRecordset(lsql, dbOpenSnapshot)
If lTBPerfis.EOF Then
MensagemErro [Ô]Erro! Nenhum registro foi localizado![Ô]
lvwLista.ListItems.Clear
txtPerfil.Text = [Ô][Ô]
lblContador.Caption = [Ô][Ô]
txtPerfil.SetFocus
Exit Sub
End If
lvwLista.ListItems.Clear [ô]Rotina deve ficar aqui, caso contrário duplica os registros da RotinaPesquisar
Do While lTBPerfis.EOF = False
Set lItem = lvwLista.ListItems.Add
lItem.Text = lTBPerfis.Fields([Ô]id_perfil[Ô]).Value
lItem.SubItems(1) = Format(lTBPerfis.Fields([Ô]data_hora[Ô]).Value, [Ô]dd/mm/yyyy hh:mm:ss[Ô])
lItem.SubItems(2) = lTBPerfis.Fields([Ô]perfil[Ô]).Value
lItem.SubItems(3) = lTBPerfis.Fields([Ô]atualizado_por[Ô]).Value
lItem.SubItems(4) = Format(lTBPerfis.Fields([Ô]ultima_atualizacao[Ô]).Value, [Ô]dd/mm/yyyy hh:mm:ss[Ô])
If lvwLista.ListItems.Count = 1 Then [ô]Caso a pesquisa filtrada retorne apenas 1 registro o botão ficará invisÃvel
cmdOrdenarPorPerfil.Enabled = False
End If
txtPerfil.Text = [Ô][Ô] [ô]Rotina para campo ficar em branco se o resultado for positivo
lblContador.Caption = lTBPerfis.RecordCount & [Ô] registro(s)[Ô] [ô]Rotina para mostrar total de registros da pesquisa
lTBPerfis.MoveNext
Loop
If lvwLista.ListItems.Count > 1 Then [ô]Se pesquisa retornar mais de 1 registro, os botões ficarão visÃveis
cmdOrdenarPorPerfil.Enabled = True
End If
End Sub
Private Sub cmdOrdenarPorPerfil_Click()
lsql = [Ô]SELECT * FROM PERFIS ORDER BY perfil ASC[Ô] [ô]Rotina que monta pesquisa
txtPerfil.SetFocus [ô]Foco vai para este campo
Set lTBPerfis = gBDSistemaIntegrado.OpenRecordset(lsql, dbOpenSnapshot)
lvwLista.ListItems.Clear
Do While lTBPerfis.EOF = False
Set lItem = lvwLista.ListItems.Add
lItem.Text = lTBPerfis.Fields([Ô]id_perfil[Ô]).Value
lItem.SubItems(1) = Format(lTBPerfis.Fields([Ô]data_hora[Ô]).Value, [Ô]dd/mm/yyyy hh:mm:ss[Ô])
lItem.SubItems(2) = lTBPerfis.Fields([Ô]perfil[Ô]).Value
lItem.SubItems(3) = lTBPerfis.Fields([Ô]atualizado_por[Ô]).Value
lItem.SubItems(4) = Format(lTBPerfis.Fields([Ô]ultima_atualizacao[Ô]).Value, [Ô]dd/mm/yyyy hh:mm:ss[Ô])
If lvwLista.ListItems.Count = 1 Then [ô]Caso a pesquisa filtrada retorne apenas 1 registro o botão abaixo ficará invisÃvel
cmdOrdenarPorPerfil.Enabled = False
End If
txtPerfil.Text = [Ô][Ô] [ô]Rotina para campo ficar em branco se o resultado for positivo
lblContador.Caption = lTBPerfis.RecordCount & [Ô] registro(s)[Ô] [ô]Rotina para mostrar total de registros da pesquisa
lTBPerfis.MoveNext
Loop
If lvwLista.ListItems.Count > 1 Then [ô]Se pesquisa retornar mais de 1 registro, os botões ficarão visÃveis
cmdOrdenarPorPerfil.Enabled = True
End If
End Sub
Private Sub RotinaSair()
Unload Me
frmMDISistema.Show
End Sub
Obrigado...
E fecha no [txt-color=#e80000]Unload[/txt-color].
Apenas as tabelas [txt-color=#e80000]Abre e Fecha[/txt-color].
Quanto ao Vba nada a comentar.
O ideal é sempre que precisar pegar alguma informação, abre e já fecha em seguida.
http://www.vbmania.com.br/index.php?modulo=forum&metodo=abrir&id=353701
Citação::
Abre apenas uma única vez no[txt-color=#e80000] Load[/txt-color] do Form.
E fecha no [txt-color=#e80000]Unload[/txt-color].
Apenas as tabelas [txt-color=#e80000]Abre e Fecha[/txt-color].
Quanto ao Vba nada a comentar.
Obrigado pela ajuda.
Citação::
Tome cuidado ao abrir a conexão e deixar aberta, o usuário pode deixar a tela aberta por muito tempo sem usar, o que pode causar problemas em uma conexão com algum servidor online por exemplo.
O ideal é sempre que precisar pegar alguma informação, abre e já fecha em seguida.
Na minha empresa passo por isso, o software vive trancando nos formulários por causa das conexões simultâneas.
Citação::
Veja.
http://www.vbmania.com.br/index.php?modulo=forum&metodo=abrir&id=353701
Irei analisar e estudar nos próximos dias este assunto.
Obrigado colegas!
Você abriu um tópico sobre navegação de registros e acabou não conseguindo o que queria e fez uma adapitação
Neste que uma conexão com banco de dados, com o mesmo exemplo irei te mostrar um solução de forma simples pro seu 2 problemas
Primeiro em um Módulo Copie e Cole, se der erro e só procurar a referencia da conexão no Google, eu não me lembro dela no momento
Public db As New ADODB.Connection
Public rs As New ADODB.Recordset
Public Path As String
Public Sub ConnectBD()
Path = App.Path & [Ô]\Banco.mdb[Ô]
db.Open [Ô]Provider=microsoft.jet.oledb.4.0;data source=[Ô] & Path
End Sub
Public Sub DesconnectBD()
If rs.State = 1 Then rs.Close: Set rs = Nothing
If db.State = 1 Then db.Close: Set db = Nothing
End Sub
No Evento Change da textbox txtCodigoPerfil, copie e cole
Private Sub txtCodigoPerfil_Change()
ConnectBD
rs.Open [Ô]SELECT codigo_perfil FROM lTBPerfis WHERE codigo_perfil = [Ô] & txtCodigoPerfil.Text, db, 3, 3
With rs
txtCodigoPerfil.Text = .Fields(1)
txtDataHora.Text = .Fields(2)
txtPerfil.Text = .Fields(3)
lblAtualizadoPor = .Fields(4)
lblUltimaAtualizacao = .Fields(5)
.Update
End With
DesconnectBD
End Sub
No Evento Click do Botão cmdProximo, copie e cole
Private Sub cmdProximo_Click()
Dim PROXIMO_REGISTRO As Integer
ConnectBD
rs.Open [Ô]SELECT codigo_perfil FROM lTBPerfis[Ô], db, 3, 3
While Not rs.EOF
If rs(0) = txtCodigoPerfil.Text Then
rs.MoveNext
PROXIMO_REGISTRO = rs(0)
rs.MoveLast [ô]INTERROPENDO O CÓDIGO POIS Jà ENCONTROU O REGISTRO
End If
rs.MoveNext
Wend
DesconnectBD
txtCodigoPerfil.Text = PROXIMO_REGISTRO
End Sub
No Evento Click do Botão cmdAnterior, copie e cole
Private Sub cmdAnterior_Click()
Dim PROXIMO_ANTERIOR As Integer
ConnectBD
rs.Open [Ô]SELECT codigo_perfil FROM lTBPerfis[Ô], db, 3, 3
While Not rs.EOF
If rs(0) = txtCodigoPerfil.Text Then
rs.MovePrevious
PROXIMO_ANTERIOR = rs(0)
rs.MoveLast
End If
rs.MoveNext
Wend
DesconnectBD
txtCodigoPerfil.Text = PROXIMO_ANTERIOR
End Sub
Citação::
Irei te ajudar de forma bem simples, e a forma que eu gosto de programar menor quantidade de linhas possÃvel
Você abriu um tópico sobre navegação de registros e acabou não conseguindo o que queria e fez uma adapitação
Neste que uma conexão com banco de dados, com o mesmo exemplo irei te mostrar um solução de forma simples pro seu 2 problemas
Primeiro em um Módulo Copie e Cole, se der erro e só procurar a referencia da conexão no Google, eu não me lembro dela no momento
Public db As New ADODB.Connection
Public rs As New ADODB.Recordset
Public Path As String
Public Sub ConnectBD()
Path = App.Path & [Ô]Banco.mdb[Ô]
db.Open [Ô]Provider=microsoft.jet.oledb.4.0;data source=[Ô] & Path
End Sub
Public Sub DesconnectBD()
If rs.State = 1 Then rs.Close: Set rs = Nothing
If db.State = 1 Then db.Close: Set db = Nothing
End Sub
No Evento Change da textbox txtCodigoPerfil, copie e cole
Private Sub txtCodigoPerfil_Change()
ConnectBD
rs.Open [Ô]SELECT codigo_perfil FROM lTBPerfis WHERE codigo_perfil = [Ô] & txtCodigoPerfil.Text, db, 3, 3
With rs
txtCodigoPerfil.Text = .Fields(1)
txtDataHora.Text = .Fields(2)
txtPerfil.Text = .Fields(3)
lblAtualizadoPor = .Fields(4)
lblUltimaAtualizacao = .Fields(5)
.Update
End With
DesconnectBD
End Sub
No Evento Click do Botão cmdProximo, copie e cole
Private Sub cmdProximo_Click()
Dim PROXIMO_REGISTRO As Integer
ConnectBD
rs.Open [Ô]SELECT codigo_perfil FROM lTBPerfis[Ô], db, 3, 3
While Not rs.EOF
If rs(0) = txtCodigoPerfil.Text Then
rs.MoveNext
PROXIMO_REGISTRO = rs(0)
rs.MoveLast [ô]INTERROPENDO O CÓDIGO POIS Jà ENCONTROU O REGISTRO
End If
rs.MoveNext
Wend
DesconnectBD
txtCodigoPerfil.Text = PROXIMO_REGISTRO
End Sub
No Evento Click do Botão cmdAnterior, copie e cole
Private Sub cmdAnterior_Click()
Dim PROXIMO_ANTERIOR As Integer
ConnectBD
rs.Open [Ô]SELECT codigo_perfil FROM lTBPerfis[Ô], db, 3, 3
While Not rs.EOF
If rs(0) = txtCodigoPerfil.Text Then
rs.MovePrevious
PROXIMO_ANTERIOR = rs(0)
rs.MoveLast
End If
rs.MoveNext
Wend
DesconnectBD
txtCodigoPerfil.Text = PROXIMO_ANTERIOR
End Sub
Hummm... Obrigado PETERSONTDS
Este assunto vou comentando ao longo dos próximos dias aqui no fórum. Preciso concluir algumas outras prioridades.