Para Realizar esta coneccion, primero se debe agregar una referencia.
Esto se hace en la opcion "Proyecto", luego "Referencia" y la opcion
"Microsoft Activex Data Object 2.8 library" o cualquier version superior.
Los codigos para la coneccion son los siguientes:
Dim Cn As ADODB.Connection
Dim Rs As ADODB.Recordset
Set Cn = New ADODB.Connection
With Cn
.ConnectionString = "DRIVER={PostgreSQL UNICODE};" _
& "SERVER=127.0.0.1;" _
& "PORT=5432;" _
& "DATABASE=NombreBd;" _
& "UID=usuario;" _
& "PWD=clave;"
.CursorLocation = adUseClient
.Open
End With
Set Rs = New ADODB.Recordset
With Rs
.ActiveConnection = Cn
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open "select * from Tabla"
End With
' Enlazamos el cursor a la grilla
Set Grilla.DataSource = Rs
' Cerramos el cursor
Rs.Close
Set Rs = Nothing
para connectionString se puede utilizar una constante:
Global Const G_STRINGCONNECTION = "DRIVER={PostgreSQL UNICODE};" _
& "SERVER=127.0.0.1;" _
& "PORT=5432;" _
& "DATABASE=NOMBRE_BASE_DATO;" _
& "UID=postgres;" _
& "PWD=admin;"
Funcion para Grabar
Public Function F_Grabar(ByRef SqlString As String) As Boolean
On Error GoTo Ocurrio_Error
F_Grabar = False
Dim Cm As New ADODB.Command
Dim Cnn As ADODB.Connection
Set Cnn = New ADODB.Connection
With Cnn
.ConnectionString = G_STRINGCONNECTION
.CursorLocation = adUseClient
.Open
End With
With Cm
.ActiveConnection = Cnn
.CommandText = UCase(SqlString)
.Execute
End With
F_Grabar = True
Cnn.Close
Exit Function
Ocurrio_Error:
MsgBox "Ocurrio un Error en Proc. F_Grabar: " & _
Err.Description, vbCritical, "ERROR EN GRABAR"
End Function
Funcion para llenar Grilla
Public Function F_Llena_Grilla(ByRef Grilla As MSHFlexGrid, ByRef SqlString As String) As Boolean
On Error GoTo Ocurrio_Error
Dim CnLoc As ADODB.Connection
Dim RsLoc As ADODB.Recordset
Set CnLoc = New ADODB.Connection
With CnLoc
.ConnectionString = G_STRINGCONNECTION
.CursorLocation = adUseClient
.Open
End With
Set RsLoc = New ADODB.Recordset
With RsLoc
.ActiveConnection = CnLoc
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open UCase(SqlString)
End With
If Not RsLoc.BOF And Not RsLoc.EOF Then
Set Grilla.DataSource = RsLoc
F_Llena_Grilla = True
End If
' Cerramos el cursor
RsLoc.Close
CnLoc.Close
Set RsLoc = Nothing
Exit Function
Ocurrio_Error:
MsgBox "Ocurrio un Error en Proc. F_Llena_Grilla: " & _
Err.Description, vbCritical, "ERROR EN BUSQUEDA"
End Function
Funcion para llenar Combobox por medio del itemdata
Public Sub S_Llena_Combos(ByRef Tabla As String, ByRef Combo As ComboBox, ByRef NumeroColumna As Integer)
On Error GoTo Ocurrio_Error
Dim SqlString As String
Dim CnLoc As ADODB.Connection
Dim RsLoc As ADODB.Recordset
SqlString = " SELECT * FROM " & Tabla
Set CnLoc = New ADODB.Connection
With CnLoc
.ConnectionString = G_STRINGCONNECTION
.CursorLocation = adUseClient
.Open
End With
Set RsLoc = New ADODB.Recordset
With RsLoc
.ActiveConnection = CnLoc
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open UCase(SqlString)
End With
If Not RsLoc.BOF And Not RsLoc.EOF Then
With Combo
.Clear
.AddItem ""
.ItemData(.NewIndex) = 0
Do While Not RsLoc.EOF
.AddItem RsLoc.Fields(NumeroColumna)
.ItemData(.NewIndex) = RsLoc.Fields(0)
RsLoc.MoveNext
Loop
End With
End If
' Cerramos el cursor
RsLoc.Close
Set RsLoc = Nothing
Exit Sub
Ocurrio_Error:
MsgBox "Ocurrio un Error en Proc. S_Llena_Combos: " & _
Err.Description, vbCritical, "ERROR EN BUSQUEDA"
End Sub
Procedimiento generico para realizar consultas sobre la BD.
Private Function F_Ejecutar_Busqueda(ByRef SqlString As String, ByRef NombreFunction As String)
Dim Retorno As Boolean
Dim RsLoc As ADODB.Recordset
Set CnLoc = New ADODB.Connection
Retorno = False
With CnLoc
.ConnectionString = G_STRINGCONNECTION
.CursorLocation = adUseClient
.Open
End With
'
Set RsLoc = New ADODB.Recordset
With RsLoc
.ActiveConnection = CnLoc
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open UCase(SqlString)
End With
If Not RsLoc.BOF And Not RsLoc.EOF Then
If RsLoc!Cuenta > 0 Then
Retorno = True
End If
End If
' Cerramos el cursor y coneccion local
RsLoc.Close
CnLoc.Close
Set RsLoc = Nothing
F_Ejecutar_Busqueda = Retorno
Exit Function
Ocurrio_Error:
MsgBox "Ocurrio un Error en Proc. " & NombreFunction & ": " & _
Err.Description, vbCritical, "ERROR EN BUSQUEDA"
End Function