ADO - Exemplo de como trabalhar com Dados

Public Function ConexaoDados() As Connection

base = PstrCamDados & "mvdoctab.mdb"

Set dbDados = New ADODB.Connection

With dbDados

    .Provider = "Microsoft.Jet.OLEDB.4.0"

    .Properties("Data Source") = base

    .Properties("Jet OLEDB:Database Password") = "password"

    .Open

End With

End Function

Public Function MostrarTodos() As ADODB.Recordset

Set rstMovimentos = New ADODB.Recordset

strSql = "SELECT * FROM tMovimentos"

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSql, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

Set MostrarTodos = rstMovimentos

Set rstMovimentos = Nothing

End Function

Public Sub Inserir()

On Error Resume Next

strSql = "INSERT INTO tMovimentos (id_movimento,"

strSql = strSql & " codigo,mov_tipo,mov_tipo2,mov_data,ent_num_contr,"

strSql = strSql & " ent_num_ei,ent_num,mov_docref,tipo_pag,not_venda,"

strSql = strSql & " data,cod_util,transfer)VALUES('" & id & "',"

strSql = strSql & " " & cod & " ,'" & movt & "','" & movd & "','" & dat & "'," & entidnc & ","

strSql = strSql & " " & entidne & ", " & entid & ",'" & ref & "','" & tp & "','" & nv & "',"

strSql = strSql & " '" & dat & "','" & ut & "', '" & transf & "')"

dbDados.Execute strSql

   Select Case Err.Number

   Case 0:

      MsgBox "Registo incluído.", vbInformation, "Atenção"

   Case -2147217864

      MsgBox "Registo excluído por outro utilizador. As alterações feitas não serão salvas.", vbInformation, "Atenção"

   Case -2147467259

      MsgBox "Registo bloqueado por outro utilizador. O Registo não pode ser incluído. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

   Case Else

      MsgBox "O Registo não pode ser incluído." + vbCrLf + Err.Description

   End Select

End Sub

Public Function ObterCodigo() As String

Dim strCod As String, intMaxCod As Integer

Set rstMovimentos = New ADODB.Recordset

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open "SELECT max(id_movimento)from tMovimentos where mid(tmovimentos.id_movimento,1,4)= '" & inicio & "'", dbDados, adOpenKeyset, adLockReadOnly, adCmdText

If IsNull(rstMovimentos.Fields(0)) Then

   ant = inicio & "000000"

   ObterCodigo = ant + 1

Else

ant = rstMovimentos.Fields(0).Value

ObterCodigo = ant + 1

End If

Set rstMovimentos = Nothing

End Function

Public Sub Alterar()

On Error Resume Next

strSql = "UPDATE tMovimentos SET tMovimentos.mov_tipo='" & movt & "',"

strSql = strSql & "tMovimentos.mov_tipo2='" & movd & "',"

strSql = strSql & "tMovimentos.mov_data = '" & CVDate(dat) & "',"

strSql = strSql & "tMovimentos.ent_num_contr=" & entidnc & ",tMovimentos.ent_num_ei=" & entidne & ","

strSql = strSql & "tMovimentos.ent_num=" & entid & ",tMovimentos.mov_docref ='" & ref & "',"

strSql = strSql & "tMovimentos.tipo_pag='" & tp & "',tMovimentos.not_venda=" & nv & ","

strSql = strSql & "tMovimentos.data= '" & CVDate(datr) & "',"

strSql = strSql & "tMovimentos.cod_util='" & ut & "',"

strSql = strSql & "tMovimentos.transfer='" & transf & "' "

strSql = strSql & "WHERE tMovimentos.id_movimento= '" & id & "' and tMovimentos.codigo=" & cod & " "

dbDados.Execute strSql

   Select Case Err.Number

   Case 0

      MsgBox "Alteração concluída.", vbInformation, "Atenção"

   Case -2147217864

      MsgBox "Registo excluído por outro utilizador. As alterações feitas não serão salvas.", vbInformation, "Atenção"

   Case -2147467259

      MsgBox "Registo bloqueado por outro utilizador. As alterações não foram salvas. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

   Case Else

      MsgBox "O Registo não pode ser alterado." + vbCrLf + Err.Description

   End Select

End Sub

Public Function Excluir()

strSql = "DELETE FROM tMovimentos "

strSql = strSql & "WHERE tMOVIMENTOS.id_movimento= '" & id & "' and tMovimentos.codigo=" & cod & ""

On Error Resume Next

dbDados.Execute strSql

Select Case Err.Number

  Case 0:

     MsgBox "Registo Excluído.", vbInformation, "Atenção"

  Case -2147217864

     MsgBox "Registo já excluído por outro utilizador.", vbInformation, "Atenção"

  Case -2147467259

     MsgBox "Registo bloqueado por outro utilizador. Exclusão não permitida. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

  Case Else

     MsgBox "O Registo não pode ser excluído." + vbCrLf + Err.Description, "Atenção"

  End Select

End Function

Public Function ConfirmarRegisto(ByVal strIdentificativo As String, ByVal strCodigo As Long) As Boolean

Set rstMovimentos = New ADODB.Recordset

strSql = "SELECT id_movimento, Codigo FROM tMovimentos"

strSql = strSql & " WHERE tMOVIMENTOS.id_movimento ='" & strIdentificativo & "'"

strSql = strSql & " and tMOVIMENTOS.Codigo = " & strCodigo & ""

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSql, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

If Not rstMovimentos.EOF Then

 ConfirmarRegisto = True

Else

 ConfirmarRegisto = False

End If

rstMovimentos.Close

Set rstMovimentos = Nothing

End Function

Public Function Consultar(ByVal strSql As String) As ADODB.Recordset

Set rstMovimentos = New ADODB.Recordset

If strSql = Null Then

   strSql = ""

End If

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSql, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

Set Consultar = rstMovimentos

Set rstMovimentos = Nothing

End Function

Public Function MostrarTodosDetalhe() As Recordset

Set rstMovimentos = New ADODB.Recordset

strSqlD = "SELECT * FROM tMovimentosdet"

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSqlD, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

Set MostrarTodosDetalhe = rstMovimentos

Set rstMovimentos = Nothing

End Function

Public Sub ExcluirTodosDetalhe()

strSqlD = "DELETE FROM tMovimentosdet "

strSqlD = strSqlD & "WHERE tMOVIMENTOSdet.id_movimento= '" & id & "' and tMovimentosdet.codigo=" & cod & ""

On Error Resume Next

dbDados.Execute strSqlD

Select Case Err.Number

  Case 0:

     MsgBox "Registo Excluído.", vbInformation, "Atenção"

  Case -2147217864

     MsgBox "Registo já excluído por outro utilizador.", vbInformation, "Atenção"

  Case -2147467259

     MsgBox "Registo bloqueado por outro utilizador. Exclusão não permitida. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

  Case Else

     MsgBox "O Registo não pode ser excluído." + vbCrLf + Err.Description, "Atenção"

  End Select

End Sub

Public Sub ExcluirRegistoDetalhe()

On Error Resume Next

strSqlD = "DELETE FROM TMovimentosDet WHERE codigo = " & cod & " AND id_movimento = '" & id & "'"

dbDados.Execute strSqlD

     Select Case Err.Number

     Case 0:

     Case -2147217864

        MsgBox "Registo já excluído por outro utilizador.", vbInformation, "Atenção"

     Case -2147467259

        MsgBox "Registo bloqueado por outro utilizador. Exclusão não permitida. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

     Case Else

        MsgBox "O registo não pode ser excluído." + vbCrLf + Err.Description, "Atenção"

     End Select

End Sub

Public Sub InserirDetalhe()

On Error Resume Next

strSqlD = "INSERT INTO TMovimentosDet (mov_tipo, art_codig, serie_id, serie_ini, serie_fim, codigo, id_movimento, serie_contad,"

strSqlD = strSqlD & "art_quant, art_valunit, valor ) VALUES ("

strSqlD = strSqlD & "'" & movt & "', '" & art & "','" & ser

strSqlD = strSqlD & "', " & ini & ", " & fim & ", " & cod

strSqlD = strSqlD & " , '" & id & "', " & contad

strSqlD = strSqlD & ", " & quant & ", " & valunit & ", " & val & ")"

dbDados.Execute strSqlD

   Select Case Err.Number

   Case 0

      Exit Sub

   Case -2147217864

      MsgBox "Registo excluído por outro utilizador. As alterações feitas não serão salvas.", vbInformation, "Atenção"

   Case -2147467259

      MsgBox "Registo bloqueado por outro utilizador. O registo não pode ser incluído. Tente mais tarde." & vbCr, vbExclamation, "Atenção"

   Case Else

      MsgBox "O registo não pode ser incluído." + vbCrLf + Err.Description

   End Select

End Sub

Public Function ConsultarDetalhe(ByVal strSqlD As String) As Recordset

Set rstMovimentos = New ADODB.Recordset

If strSql = Null Then

   strSql = ""

End If

rstMovimentos.CursorLocation = adUseClient

rstMovimentos.Open strSql & strSql, dbDados, adOpenKeyset, adLockReadOnly, adCmdText

Set ConsultarDetalhe = rstMovimentos

Set rstMovimentos = Nothing

End Function