by Jo?o Mateus (1 Submission)
Category: Databases/Data Access/DAO/ADO
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Fri 24th September 2004
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
ADO_Exemplo de como trabalhar com dados
VBcoders
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 = adUseServer
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 permitstrIdentificativoa. 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
