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
' "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
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
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
Sub MiMacro()
ResponderBorrarDim i As Integer
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
i = Range(Selection, Selection.End(xlDown)).Count
MsgBox i
End Sub
Ejemplo de cadena de conexión para MySQL
ResponderBorrarMiCSQL.CadenaConexionBD = "Driver={MySQL ODBC 3.51 Driver};Server=localhost;Database=prueba;User=root;Password=;Option=3;"