Clase para hacer consultas SQL a BD en VBA



Módulo de Clase (Nombre: ConsultaSQL):

'NOTA: Marcar referencia (Herramienta -> Referencias...)
'           "Microsoft ActiveX Data Object 2.8 Library"

'OBJETIVO: Realizar una consulta a una BD y almacenar el resultado en:

'   - Un libro de Excel determinado.
'   - Un control ListBox (Solo el primer campo).
'   - Un control ComboBox (Solo el primer campo).
'   - Un control TextBox.
'   - Un control FlexGrid.

'USO de esta clase:

'   1.- Establecer las propiedades para la comunicación con la BD:
'       - CSQL.                         (Consulta SQL)
'       - RutaBD.                       (Ruta de ubicación de la BD)
'       - TipoConexionBD.               (Tipo de conexión de la BD)
'   2.- En caso de seleccionar 'Otro' como tipo de conexión, establecer la propiedad:
'       - CadenaConexionBD.             (Cadena de conexión de la BD)
'   3.- Ejecutar la consulta SQL mediante el método:
'       - EjecutarConsultaSQL.          (Ejecutar consulta SQL)
'   4.- Establecer las propiedades salida de la consulta SQL (Solo en caso de LibroExcel):
'       - Libro.
'       - Hoja.
'       - iFil.
'       - iCol.
'   5.- Vaciar resultados de la consulta SQL mediante algunos de los siguiente métodos:
'       - VaciarConsultaEnLibroExcel.   (Libro de Microsoft Excel)
'       - VaciarConsultaEnControl.      (Control ListBox, ComboBox, TextBox o FlexGrid)


'*** INICIO: Enumaraciones públicas ***

'Tipo de conexión de BD
Public Enum EnumTipoConexionBD
    MExcel                      'Microsoft Excel
    MAccess                     'Microsoft Access
    ActiveDirectory             'Directorio Activo
    dBase                       'dBase
    Otro                        'En caso de otro se debe indicar la cadena de conexión
End Enum
'*** FIN: Enumaraciones públicas ***

'*** INICIO: Propiedades públicas ***

Public strNotificaciones As String              'Notificaciones de estado de la clase
'*** FIN: Propiedades públicas ***

'*** INICIO: Variables privadas asociadas a propiedades ***

'Parámetros de comunicación con la BD
Private strCSQL As String                       'Consulta SQL
Private strRutaBD As String                     'Ruta de ubicación de la BD
Private eTipoConexionBD As EnumTipoConexionBD   'Tipo de conexión de la BD
Private strCadenaConexionBD As String           'Cadena de conexión de la BD
'Parámetros de salida de la consulta SQL
Private strLibro As String                      'Libro de Excel destino
Private strHoja As String                       'Hoja de Excel destino
Private iFil As Integer                         'Fila de Excel destino
Private iCol As Integer                         'Columna de Excel destino
'*** FIN: Variables privadas asociadas a propiedades ***

'*** INICIO: Propiedades privadas ***

Private cn As ADODB.Connection                  'Objeto de conexión
Private rst As ADODB.Recordset                  'Objeto de recorset
'*** FIN: Propiedades privadas ***

'*** INICIO: ESTABLECER Y OBTENER PROPIEDADES DE LA CLASE ***

'Obtener propiedad de la consulta SQL
Property Get CSQL() As String
    CSQL = strCSQL
End Property

'Establecer propiedad de la consulta SQL

Property Let CSQL(strCSQLNew As String)
    If strCSQLNew = "" Then
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- No se ha establecido una consulta SQL."
    Else
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- Consulta SQL: " & strCSQLNew & "."
    End If
    strCSQL = strCSQLNew
End Property

'Obtener propiedad de la ruta de ubicación de la BD

Property Get RutaBD() As String
    RutaBD = strRutaBD
End Property

'Establecer propiedad de la ruta de ubicación de la BD

Property Let RutaBD(strRutaBDNew As String)
    If DirExiste(strRutaBDNew) Then
        strRutaBD = strRutaBDNew
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- Ruta de la BD: " & strRutaBDNew & "."
    Else
        strRutaBD = ""
        strNotificaciones = strNotificaciones & vbCrLf & "- La ruta de la BD: " & _
            strRutaBDNew & " no existe."
    End If
End Property

'Obtener propiedad del tipo de conexion de la BD

Property Get TipoConexionBD() As EnumTipoConexionBD
    TipoConexionBD = eTipoConexionBD
End Property

'Establecer propiedad del tipo de conexion de la BD

Property Let TipoConexionBD(eTipoConexionNew As EnumTipoConexionBD)
    Select Case eTipoConexionNew
        Case MExcel
            strNotificaciones = strNotificaciones & vbCrLf & _
                "- Se estableció 'Excel' como tipo de conexión."
        Case MAccess
            strNotificaciones = strNotificaciones & vbCrLf & _
                "- Se estableció 'Access' como tipo de conexión."
        Case ActiveDirectory
            strNotificaciones = strNotificaciones & vbCrLf & _
                "- Se estableció 'Active Directory' como tipo de conexión."
        Case dBase
            strNotificaciones = strNotificaciones & vbCrLf & _
                "- Se estableció 'dBase' como tipo de conexión."
        Case Otro
            strNotificaciones = strNotificaciones & vbCrLf & _
                "- Se estableció 'Otro' como tipo de conexión."
        Case Else
            strNotificaciones = strNotificaciones & vbCrLf & _
                "- No se ha establecido ningún tipo de conexión."
    End Select
    eTipoConexionBD = eTipoConexionNew
End Property

'Obtener propiedad de la cadena de conexión de BD

Property Get CadenaConexionBD() As String
    CadenaConexionBD = strCadenaConexionBD
End Property

'Establecer propiedad de la cadena de conexión de BD

Property Let CadenaConexionBD(strCadenaConexionBDNew As String)
    If strCadenaConexionBDNew = "" Then
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- No se ha establecido cadena de conexión."
    Else
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- Cadena de conexión: " & strCadenaConexionBDNew & "."
    End If
    strCadenaConexionBD = strCadenaConexionBDNew
End Property

'Obtener propiedad de la ruta completa del libro Excel de salida

Property Get Libro() As String
    Libro = strLibro
End Property

'Establecer propiedad de la ruta completa del libro de salida

Property Let Libro(strLibroNew As String)
    If DirExiste(strLibroNew) Then
        strLibro = strLibroNew
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- Libro Excel destino: " & strLibroNew & "."
    Else
        strLibro = ""
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- El libro Excel destino: " & strLibroNew & " no existe."
    End If
End Property

'Obtener propiedad de la hoja de Excel

Property Get Hoja() As String
    Hoja = strHoja
End Property

'Establecer propiedad de la hoja de Excel

Property Let Hoja(strHojaNew As String)
    If strHojaNew <> "" Then
        strHoja = strHojaNew
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- Hoja de Excel destino: " & strHojaNew & "."
    Else
        strHoja = ""
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- No se ha establecido la hoja de Excel destino."
    End If
End Property

'Obtener fila destino

Property Get Fil() As String
    Fil = iFil
End Property

'Establecer fila destino

Property Let Fil(iFilNew As String)
    If iFilNew > 1 Then
        iFil = iFilNew
    Else
        iFil = 1
    End If
    strNotificaciones = strNotificaciones & vbCrLf & _
        "- Fila de la Hoja destino: " & iFilNew & "."
End Property

'Obtener columna destino

Property Get Col() As String
    Col = iCol
End Property

'Establecer columna destino

Property Let Col(iColNew As String)
    If iColNew > 1 Then
        iCol = iColNew
    Else
        iCol = 1
    End If
    strNotificaciones = strNotificaciones & vbCrLf & _
        "- Columna de la Hoja destino: " & iColNew & "."
End Property
'*** FIN: ESTABLECER Y OBTENER PROPIEDADES DE LA CLASE ***

'*** INICIO: Métodos públicos ***

'Ejecutar consulta SQL
Public Sub EjecutarConsultaSQL()
    'En caso de error salir del método
    On Error GoTo Salir
    
    'Establecer cádena de conexión
    EstablecerCadenaConexionBD
    
     'Crea un nuevo objeto recordset
    Set rst = CreateObject("ADODB.Recordset")

    'Crea un objeto Conexión

    Set cn = CreateObject("ADODB.Connection")
    
    'Establece la cádena de conexión a usar
    cn.ConnectionString = strCadenaConexionBD
    
    'Verifica que la consulta SQL no este vacia
    If strCSQL <> vbNullString Then
        'Abre la conexión a la base de datos
        cn.Open
        
        'Ejecuta la sentencia SQL para llenar el recordset
        rst.Open strCSQL, cn
        
        'Notifica que la consulta SQL se ejecutó
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- La consulta SQL se ha ejecutado."
        Exit Sub
    End If
Salir:
    strNotificaciones = strNotificaciones & vbCrLf & _
        "- No se pudo ejecutar la consulta SQL."
End Sub

'Vaciar consulta en libro de Excel

Public Sub VaciarConsultaEnLibroExcel()
    On Error GoTo Salir
    Dim i As Integer                    'Contador
    Dim bLibroDestinoAbierto As Boolean 'Indica si el libro estaba abierto antes de pasar
                                        'los resultados de la consulta

    'Prepara el libro de Excel

    If LibroExcelAbierto(strLibro) Then
        'Verifica si existe un libro abierto con el mismo nombre del libro destino
        If Workbooks(Dir(strLibro)).FullName <> strLibro Then
            MsgBox "Existe un libro abierto con el mismo nombre del libro destino." _
                & vbCrLf & "Favor cerrar libro."
            strNotificaciones = strNotificaciones & vbCrLf & _
                "- Existe un libro abierto con el mismo nombre del libro destino."
            Exit Sub
        End If
        bLibroDestinoAbierto = True
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- Libro destino inicialmente abierto."
    Else
        Workbooks.Open strLibro
        bLibroDestinoAbierto = False
        strNotificaciones = strNotificaciones & vbCrLf & _
            "- Libro destino inicialmente cerrado."
    End If
    
    'Recorre las columnas y añade el nombre del campo al encabezado
    For i = 0 To rst.Fields.Count - 1
        Workbooks(Dir(strLibro)).Sheets(strHoja).Cells(iFil, iCol + i).Value = _
            rst.Fields(i).Name
    Next
    Workbooks(Dir(strLibro)).Sheets(strHoja).Cells(iFil + 1, iCol).CopyFromRecordset rst
     
    'Cierra el libro de estar si se encontraba cerrado antes de cargar la consulta SQL
    If Not (bLibroDestinoAbierto) Then
        Application.DisplayAlerts = False
        Workbooks(Dir(strLibro)).Close True
        Application.DisplayAlerts = True
    End If
    
    strNotificaciones = strNotificaciones & vbCrLf & _
        "- La consulta se vació en el Libro de Excel."
    
    Exit Sub
Salir:
    strNotificaciones = strNotificaciones & vbCrLf & _
        "- ADVERTENCIA: La consulta NO se vació en el Libro de Excel."
End Sub

'Vaciar consulta en control ListBox o ComboBox

Public Sub VaciarConsultaEnControl(ByRef Control As Object)
    On Error GoTo Salir
    Dim i As Integer    'Contador
    Dim j As Integer    'Contador
    
    'Mover apuntador de consulta al primer registro
    rst.MoveFirst
    
    'En caso de un control ListBox o ComboBox
    If (TypeName(Control) = "ListBox") Or (TypeName(Control) = "ComboBox") Then
        Control.Clear
        Do Until rst.EOF
            Control.AddItem rst.Fields(0)
            rst.MoveNext
        Loop
    End If
    
    'En caso de un control TextBox
    If (TypeName(Control) = "TextBox") Then
        Dim strConsultaSQL As String
        Dim strLinea As String
        strConsultaSQL = ""
        Control.ScrollBars = fmScrollBarsBoth
        Control.MultiLine = True
        'Recorre las columnas y añade el nombre del campo al encabezado
        strLinea = ""
        For i = 0 To rst.Fields.Count - 1
            strLinea = strLinea & rst.Fields(i).Name & vbTab
        Next
        strConsultaSQL = strConsultaSQL & strLinea & vbCrLf
        'Llena los registros
        Do Until rst.EOF
            strLinea = ""
            For i = 0 To rst.Fields.Count - 1
                strLinea = strLinea & rst.Fields(i) & vbTab
            Next i
            strConsultaSQL = strConsultaSQL & strLinea & vbCrLf
            rst.MoveNext
        Loop
        Control.Text = strConsultaSQL
    End If
    
    'En caso de un control MSFlexGrid2
    If (TypeName(Control) = "MSFlexGrid2") Then
        Control.FixedCols = 0
        Control.FixedRows = 1
        Control.Cols = rst.Fields.Count
        'Recorre las columnas y añade el nombre del campo al encabezado
        For i = 0 To rst.Fields.Count - 1
            Control.TextMatrix(0, i) = rst.Fields(i).Name
        Next
        'Llena los registros
        j = 1
        Do Until rst.EOF
            Control.Rows = j + 1
            For i = 0 To rst.Fields.Count - 1
                Control.TextMatrix(j, i) = rst.Fields(i)
            Next i
            j = j + 1
            rst.MoveNext
        Loop
    End If
    strNotificaciones = strNotificaciones & vbCrLf & _
        "- La consulta se vació en un control " & TypeName(Control) & "."
    Exit Sub
Salir:
    strNotificaciones = strNotificaciones & vbCrLf & _
        "- DVERTENCIA: La consulta NO se vació en un control " & TypeName(Control) & "."
End Sub

'Indicaciones de uso de la clase

Public Function IndicacionesClassConsultaSQL() As String
    Const INDICACIONES1 As String = _
        "1.- Establecer las propiedades para la comunicación con la BD:" & vbCrLf & _
        "       - CSQL (Consulta SQL)." & vbCrLf & _
        "       - RutaBD (Ruta de ubicación de la BD)." & vbCrLf & _
        "       - TipoConexionBD (Tipo de conexión de la BD)." & vbCrLf & _
        vbCrLf & _
        "2.- En caso de seleccionar 'Otro' como tipo de conexión, establecer la " & _
        "propiedad:" & vbCrLf & _
        "       - CadenaConexionBD (Cadena de conexión de la BD)." & vbCrLf & _
        vbCrLf & _
        "3.- Ejecutar la consulta SQL mediante el método:" & vbCrLf & _
        "       - EjecutarConsultaSQL (Ejecutar consulta SQL)." & vbCrLf & _
        vbCrLf
    Const INDICACIONES2 As String = _
        "4.- Establecer las propiedades salida de la consulta SQL " & _
        "(Solo en caso de LibroExcel):" & vbCrLf & _
        "       - Libro." & vbCrLf & _
        "       - Hoja." & vbCrLf & _
        "       - iFil" & vbCrLf & _
        "       - iCol." & vbCrLf & _
        vbCrLf & _
        "5.- Vaciar resultados de la consulta SQL mediante algunos de los siguiente " & _
        "métodos:" & vbCrLf & _
        "       - VaciarConsultaEnLibroExcel (Libro de Microsoft Excel)." & vbCrLf & _
        "       - VaciarConsultaEnControl (Control ListBox, ComboBox, TextBox o FlexGrid)."
        
    IndicacionesClassConsultaSQL = INDICACIONES1 & INDICACIONES2
End Function
'*** FIN: Métodos públicos ***

'*** INICIO: Métodos privados ***

'Establecer cadena de conexión BD
Private Sub EstablecerCadenaConexionBD()
    Dim strDirBD As String  'Directorio de la BD
    
    Select Case eTipoConexionBD
        Case MExcel
            'Obtiene el directorio en donde se encuentra la BD
            strDirBD = Left(strRutaBD, Len(strRutaBD) - Len(Dir(strRutaBD)) - 1)
            strCadenaConexionBD = "ODBC;DBQ=" & strRutaBD & ";DefaultDir=" & strDirBD & _
            ";Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
            "DriverId=1046;FIL=excel 12.0;MaxBufferSize=2048;" & _
            "MaxScanRows=8;PageTimeout=5;ReadOnly=1;SafeTransactions=0;" & _
            "Threads=3;UID=admin;UserCommitSync=Yes;"
        Case MAccess
            strCadenaConexionBD = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
                strRutaBD & ";Persist Security Info=False;"
        Case ActiveDirectory
            strCadenaConexionBD = "Provider=ADsDSOObject"
        Case dBase
            'Obtiene el directorio en donde se encuentra la BD
            strDirBD = Left(strRutaBD, Len(strRutaBD) - Len(Dir(strRutaBD)) - 1)
            strCadenaConexionBD = "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;" _
                & "Dbq=" & strDirBD & ";"
        Case Otro
            Exit Sub
        Case Else
            strCadenaConexionBD = ""
            strMensaje = strMensaje & vbCrLf & "- No se estableció cadena de conexión."
            Exit Sub
    End Select
    strNotificaciones = strNotificaciones & vbCrLf & _
            "- La cadena de conexión es: " & strCadenaConexionBD
End Sub

'Verifica si un libro de Excel esta abierto

Function LibroExcelAbierto(strLibro As String) As Boolean
    Dim LibroExcel As Workbook
    On Error Resume Next
    Set LibroExcel = Application.Workbooks.Item(Dir(strLibro))
    LibroExcelAbierto = (Not LibroExcel Is Nothing)
End Function

'Verifica si una ruta de archivo o directorio es valida

Private Function DirExiste(strPath As String) As Boolean
    On Error GoTo Salir
    If Dir(strPath, vbDirectory) <> "" Then
        DirExiste = True
    Else
        DirExiste = False
    End If
    Exit Function
Salir:
    DirExiste = False
End Function
'*** FIN: Métodos privados ***

Private Sub Class_Initialize()

    iFil = 1
    iCol = 1
End Sub

Private Sub Class_Terminate()

    'Libera memoria
    If IsEmpty(rst) Then
        rst.Close
        Set rst = Nothing
    End If
    If IsEmpty(cn) Then
        cn.Close
        Set cn = Nothing
    End If
End Sub


Ejemplo de Módulo standar para instanciar la clase:

Public Sub PruebaSQLExcel()
    Dim MiCSQL As ConsultaSQL
    Set MiCSQL = New ConsultaSQL
    
    'Indicaciones de uso de la clase
    MsgBox MiCSQL.IndicacionesClassConsultaSQL
    
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT * FROM [Productos$] WHERE TipoCompra = 'Locales'"
    MiCSQL.RutaBD = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Servidor\BD OCyG.xlsx"
    MiCSQL.TipoConexionBD = MExcel
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Establecer las propiedades salida de la consulta SQL
    MiCSQL.Libro = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Excel SQL V06.xlsm"
    MiCSQL.Hoja = "SalidaExcel"
    MiCSQL.Fil = 1
    MiCSQL.Col = 2
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnLibroExcel
    
    'Notificaciones
    MsgBox MiCSQL.strNotificaciones
    
    Set MiCSQL = Nothing
End Sub

Public Sub PruebaSQLAccess()
    Dim MiCSQL As ConsultaSQL
    Set MiCSQL = New ConsultaSQL
    
    'Indicaciones de uso de la clase
    MsgBox MiCSQL.IndicacionesClassConsultaSQL
    
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT * FROM [Volumen] WHERE Evento = 'MVFA 2017'"
    MiCSQL.RutaBD = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Servidor\BD OCyG.accdb"
    MiCSQL.TipoConexionBD = MAccess
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Establecer las propiedades salida de la consulta SQL
    MiCSQL.Libro = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Excel SQL V06.xlsm"
    MiCSQL.Hoja = "SalidaAccess"
    MiCSQL.Fil = 1
    MiCSQL.Col = 2
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnLibroExcel
    
    'Notificaciones
    MsgBox MiCSQL.strNotificaciones
    
    Set MiCSQL = Nothing
End Sub

Public Sub PruebaSQLAD()
    Dim MiCSQL As ConsultaSQL
    Set MiCSQL = New ConsultaSQL
    
    'Indicaciones de uso de la clase
    MsgBox MiCSQL.IndicacionesClassConsultaSQL
    
    '1ra Consulta
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT telephoneNumber, title, UID FROM 'LDAP://CCSCAM05' WHERE pdvsacom-ad-Cedula = 16953252"
    MiCSQL.TipoConexionBD = ActiveDirectory
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Establecer las propiedades salida de la consulta SQL
    MiCSQL.Libro = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Excel SQL V06.xlsm"
    MiCSQL.Hoja = "SalidaAD"
    MiCSQL.Fil = 1
    MiCSQL.Col = 2
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnLibroExcel
    
    '2da Consulta
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT ipPhone, mail FROM 'LDAP://CCSCAM05' WHERE UID = 'SANTAELLAFS'"
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Establecer las propiedades salida de la consulta SQL
    MiCSQL.Libro = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Excel SQL V06.xlsm"
    MiCSQL.Hoja = "SalidaAD"
    MiCSQL.Fil = 3
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnLibroExcel
    
    '3ra Consulta
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT DisplayName FROM 'LDAP://CCSCAM05' WHERE UID = 'BAZOP' OR UID = 'PRIMERANP' OR UID = 'OMANANJ'"
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Establecer las propiedades salida de la consulta SQL
    MiCSQL.Libro = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Excel SQL V06.xlsm"
    MiCSQL.Hoja = "SalidaAD"
    MiCSQL.Fil = 5
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnLibroExcel
    
    '4ta Consulta
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT employeeID FROM 'LDAP://CCSCAM05' WHERE UID = 'SANCHEZMAV'"
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Establecer las propiedades salida de la consulta SQL
    MiCSQL.Libro = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Excel SQL V06.xlsm"
    MiCSQL.Hoja = "SalidaAD"
    MiCSQL.Fil = 9
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnLibroExcel    'Notificaciones
    MsgBox MiCSQL.strNotificaciones
    
    Set MiCSQL = Nothing
End Sub

Public Sub PruebaSQLdBase()
    Dim MiCSQL As ConsultaSQL
    Set MiCSQL = New ConsultaSQL
    
    'Indicaciones de uso de la clase
    MsgBox MiCSQL.IndicacionesClassConsultaSQL
    
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT * FROM [centros.dbf] WHERE COD_EDO = 1"
    MiCSQL.RutaBD = "D:\MaiSanta\repdbf.dbf"
    MiCSQL.TipoConexionBD = dBase
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Establecer las propiedades salida de la consulta SQL
    MiCSQL.Libro = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Excel SQL V06.xlsm"
    MiCSQL.Hoja = "Salida dBase"
    MiCSQL.Fil = 1
    MiCSQL.Col = 2
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnLibroExcel
    
    'Notificaciones
    MsgBox MiCSQL.strNotificaciones
    
    Set MiCSQL = Nothing
End Sub

Public Sub PruebaSQLOtros()
    Dim MiCSQL As ConsultaSQL
    Set MiCSQL = New ConsultaSQL
    
    'Indicaciones de uso de la clase
    MsgBox MiCSQL.IndicacionesClassConsultaSQL
    
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT * FROM [centros.dbf] WHERE PARROQUIA = 'PQ. LA PASTORA'"
    MiCSQL.TipoConexionBD = Otro
    MiCSQL.CadenaConexionBD = "Driver={Microsoft dBASE Driver (*.dbf)};DriverID=277;" & "Dbq=D:\MaiSanta;"
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Establecer las propiedades salida de la consulta SQL
    MiCSQL.Libro = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Excel SQL V06.xlsm"
    MiCSQL.Hoja = "SalidaOtros"
    MiCSQL.Fil = 1
    MiCSQL.Col = 2
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnLibroExcel
    
    'Notificaciones
    MsgBox MiCSQL.strNotificaciones
    
    Set MiCSQL = Nothing
End Sub

Ejemplo de formulario para instanciar la clase:


Private Sub cmdEjecutarConsultasSQL_Click()
    Dim MiCSQL As ConsultaSQL
    Set MiCSQL = New ConsultaSQL
    
    'Establecer las propiedades para la comunicación con la BD
    MiCSQL.CSQL = "SELECT * FROM [Presupuesto$] WHERE Evento = 'Real 2017'"
    MiCSQL.RutaBD = "F:\Petrix\Proyectos Propios\2019 Excel SQL\Servidor\BD OCyG.xlsx"
    MiCSQL.TipoConexionBD = MExcel
    
    'Ejecutar el consulta SQL
    MiCSQL.EjecutarConsultaSQL
    
    'Vaciar resultados de la consulta SQL
    MiCSQL.VaciarConsultaEnControl ListBox1
    MiCSQL.VaciarConsultaEnControl ComboBox1
    MiCSQL.VaciarConsultaEnControl MSFlexGrid1
    MiCSQL.VaciarConsultaEnControl TextBox1
    
    'Notificaciones
    MsgBox MiCSQL.strNotificaciones
    
    Set MiCSQL = Nothing
End Sub




Comentarios

  1. Sub MiMacro()
    Dim i As Integer
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    i = Range(Selection, Selection.End(xlDown)).Count
    MsgBox i
    End Sub

    ResponderBorrar
  2. Ejemplo de cadena de conexión para MySQL
    MiCSQL.CadenaConexionBD = "Driver={MySQL ODBC 3.51 Driver};Server=localhost;Database=prueba;User=root;Password=;Option=3;"

    ResponderBorrar

Publicar un comentario

Entradas más populares de este blog

Ruta hacia el desarrollador web full stack en Soluciones++

Soluciones++ para VBA