Ir para conteúdo
Fórum Script Brasil
  • 0

Dao E Ado


Humm

Pergunta

bom, peguei um codigo de exemplo mas não consigo aplica-lo no meu programa.

estou desconfiado que a conexao do meu é ADO e esse codigo foi feito com DAO e por isso n deve funcionar

como faco pra saber qual tipo de conexao estou usando na minha aplicacao access?

como posso fazer um codigo DAO funcionar em ADO?

Option Compare Database
Option Explicit

' Desenvolvido por JR - <accessjr@bol.com.br>
' Brasília - DF, em Jan/1999.
' http://www.accessjr.cjb.net

' Estas variáveis permanecerão abertas enquanto
' o formulário estiver aberto para agilizar
' as buscas subseqüentes.
Dim rs As DAO.Recordset, Rs1 As DAO.Recordset
Dim mValor As Variant

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
    Set rs = Nothing   'Libera memória
    Set Rs1 = Nothing
End Sub

Private Sub cmdCancelar_Click()
On Error Resume Next
    DoCmd.Close
End Sub

Private Sub cmdSeguir_Click()
On Error GoTo Err_cmdExibir
    With lstRetorno
        If .ListCount = 0 Then GoTo Termina
    End With

    MsgBox "Aqui você coloca o seu código para" _
      & vbCrLf & "usar o item selecionado na listbox."

Termina:
    Exit Sub
    
Err_cmdExibir:
    Select Case Err
    Case 94
        MsgBox "Selecione um Nome na caixa de listagem.", vbInformation, "Informação"
    Case Else
        MsgBox Err.Description, vbCritical, "Erro"
    End Select
    Resume Termina
    
End Sub

Private Sub cmdLimpar_Click()
On Error Resume Next
    txtPesquisa = ""
    txtPesquisa.SetFocus
    Rs1.Close
    lstRetorno.Requery
    lblSelecionadas.Caption = "Nenhum Nome Selecionado"
End Sub

Private Sub lstRetorno_DblClick(Cancel As Integer)
On Error Resume Next
    Call cmdSeguir_Click
End Sub

Private Sub txtPesquisa_Change()
Dim strSQL As String
On Error GoTo Rs_Fechado

Pesquisa:
    mValor = txtPesquisa.Text
    If Len(mValor & "") = 0 _
        Or Asc(mValor) = 32 Then 'Limpa espaços também.
        Call cmdLimpar_Click
        Exit Sub
    End If

    'Na primeira vez, a rotina desviará para o rótulo
    'Rs_Fechado, pois o Recordset ainda não foi aberto.
    'Na 2ª vez em diante, a rotina prossegue normalmente.
    With rs
        .Filter = "NOME Like '*" & adhHandleQuotes(mValor, "'") & "*'"
        Set Rs1 = .OpenRecordset
        'Move para último p/ fazer contagem na função PreencheLista
        If Rs1.RecordCount <> 0 Then Rs1.MoveLast
        lstRetorno.Requery
    End With

Fim:
    Exit Sub

Rs_Fechado:
    Select Case Err
    Case 91, 3420  'Ocorre só na primeira vez em que é pesquisado um item.
        strSQL = "SELECT NOME, CODE " _
            & "FROM CLIENTES ORDER BY NOME"
        'Cria um recordset bem rápido, pois é SnapShot.
        Set rs = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenSnapshot)
        GoTo Pesquisa
    Case 5  'ocorre ao voltar com BackSpace, apagando o texto.
        Resume Next
    Case Else
        MsgBox "Erro nº " & Err & vbCrLf _
          & Err.Description, vbCritical, "Erro"
    End Select
    Resume Fim

End Sub

Function PreencheLista(ctl As Control, varID As Variant, lngRow As Long, _
                       lngCol As Long, intCode As Integer) As Variant

    'Função CallBack padrão para preencher Combo/List box.
    On Error GoTo Err_Preenche

    Dim valret As Variant 'Retorno p/ cada um dos intCode indicados em Select Case.
    Dim I As Integer
    Static strNome() As Variant   'cria matriz dinâmica
    Static sContaReg As Integer
    sContaReg = Rs1.RecordCount
    I = 0
    valret = Null
    Select Case intCode
        Case acLBInitialize             ' Inicializa.
            With Rs1
                ReDim strNome(sContaReg, 1) 'redimensiona conforme nº linhas do recordset
                .MoveFirst
                For I = 0 To sContaReg - 1
                    strNome(I, 0) = !NOME
                    strNome(I, 1) = !CODE
                    .MoveNext
                Next I
            End With
            valret = True 'deve ser diferente de zero ou Null para prosseguir.

        Case acLBOpen               ' Abre.
            valret = Timer      ' Gera Código exclusivo.
        Case acLBGetRowCount        ' Obtém linhas.
            valret = -1         ' significa desconhecido
        'Case acLBGetColumnCount    ' Obtém colunas.
            'valret = 2
        'Case acLBGetColumnWidth    ' Obtém a largura da coluna.
            'valret = -1        ' Utiliza a largura padrão.
        Case acLBGetValue           ' Obtém os dados.
            valret = strNome(lngRow, lngCol)
        Case acLBEnd                'Fim
            Erase strNome           'limpa a matriz.
    End Select
    PreencheLista = valret  'preenche a Listbox
    lblSelecionadas.Caption = sContaReg & " Nome(s) Selecionado(s)"
    Exit Function

Err_Preenche:
    Select Case Err
    Case 9, 91    ' Erro gerado na 1ª vez que abrir
        Resume Next
    Case 3420, 3021      ' Causado pelo botão Limpar (Rs1.Close)
        PreencheLista = Null
    Case Else
        MsgBox "Erro nº " & Err & vbCrLf _
          & Err.Description, vbCritical, "Erro"
    End Select
    
End Function

Link para o comentário
Compartilhar em outros sites

4 respostass a esta questão

Posts Recomendados

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.



  • Estatísticas dos Fóruns

    • Tópicos
      152,3k
    • Posts
      652,3k
×
×
  • Criar Novo...