Archive

Posts Tagged ‘SQL’

Obtener datos de Access, SQL, MySql, Web, txt, etc. desde Excel sin vba

Cuando se trabaja con diferentes gestores de bases de datos (SGBD) o DBMA (DataBase Management System) o simplemente queremos obtener datos de otros orígenes, siempre llega la necesidad de extraer esos datos a nuestra hoja de cálculo, que en este caso es Excel.

Y como no todo debe ser ‘vba’, exploremos las grandes prestaciones que ya de por sí nos ofrece Excel: Obtener datos externos.

Fácil, pero desconocido

Sólo tendremos que entrar a la pestaña Datos y tenemos opciones como Access, Web, texto, SQL y otras fuentes de datos.

Para los distintos orígenes, tenemos diferentes variantes:

ORIGEN COMENTARIOS
Access Elegimos la base de datos y seleccionamos la tabla.
Web Ingresamos la dirección URL de la página.
Texto Elegimos el archivo txt.
SQL Ingresamos el nombre o la IP del servidor, usuario, contraseña, elegimos la base de datos y la tabla.
MySql Debemos bajar el driver que nos permita hacer la conexión.
Fox Pro Elegimos nuestra base de datos.

image

Excel nos da prestaciones intersantes para importar datos de diferentes orígenes.

Exportar grandes cantidades de datos de Access a Excel con SELECT TOP

May 10, 2012 2 comments

Imaginemos que tenemos una base de datos de Access de varios millones de registros y los queremos pasar a Excel, lo cual puede resultar una tarea extenuante (creanme, jajaja!!).

Como primera opción podemos hacer una consulta de datos de Excel a Access con las herramientas que nos ofrece Excel (Datos > Desde Access), pero llegará el momento en nos arroje un mensaje de advertencia como “La consulta devolvió más datos de los que se admiten en una hoja de cálculo”. Excel 2010 sólo acepta 1’048,576 filas de datos, lo cual puede ser suficiente para ciertas bases de datos, pero insuficientes para bases ‘enormes’.

Procedimiento

Abrimos nuestra base de datos de Access, la cual contiene más de 1 millón de registros. El primer pasó será crear una consulta: Crear > Asistente para consultas > Asistente para consultas sencillas… Elegimos los campos que queremos consultar y damos Finalizar.

La consulta nos arrojará todos nuestros datos de la tabla. Ahorá el momento de realizar una consulta SQL para seccionar nuestra tabla y así hacer exportaciones a Excel con registros de hasta 1 millón.

Elegimos el botón que dice SQL en la parte inferior derecha, tal como se muestra en la imagen:

image

Nos mostrará una pantalla blanca donde realizaremos nuestras consulta SQL:

Traer los primeros 1 millón de registros

SELECT TOP 1000000  *
FROM BASE_110408
ORDER BY ID ASC;

Traer los últimos 500,000 registros del final

SELECT TOP 500000  *
FROM BASE_110408
ORDER BY ID DES;

Traer el 50% de los primeros registros

SELECT TOP 50 PERCENT  *
FROM BASE_110408
ORDER BY ID ASC;

Traer el 50% de los últimos registros

SELECT TOP 50 PERCENT  *
FROM BASE_110408
ORDER BY ID DESC;

image

Exportar datos a Excel

Una vez que ejecutamos nuestra consulta, podemos exportar los datos a Excel. Sólo elegimos Datos externos > Excel… y seguimos los pasos.

image

Renombrar archivo de Excel con vba sin necesidad de cerrar y abrir

March 21, 2012 2 comments

En cuántas ocasiones te ha pasado que el archivo con el que estás trabajando necesitas cambiarle el nombre ??

El procedimiento que seguramente realizarías es: cerrar el archivo, ir al explorador de windows, ubicar el archivo y darle en cambiar nombre; posteriormente abriríamos el archivo.

En un inicio, la siguiente macro detecta el tipo de archivo (.xls, .xlsx, .xlsm) para que sea el mismo que el archivo nuevo. Posteriormente nos muestra el cuadro diálogo Guardar como… para que ingresemos el nuevo nombre.

Código de la macro 

':: Fecha de creación, 19-abr-11
':: Propósito, renombrar archivo actual
'... macro incluída en EXCELeINFO add-in, apartado Archivos
Sub EXCELeINFORenombrarArchivoActual()
Dim Ext As String
Dim NombreArchivo
Dim NombreActual As String
Dim RutaArchivo As String
Dim NombreCompleto As String
Dim Msj As String
On Error GoTo Errores
NombreActual = ActiveWorkbook.Name
RutaArchivo = ActiveWorkbook.Path
NombreCompleto = RutaArchivo & "\" & NombreActual
'Detecta la extensión del libro actual.
Select Case ActiveWorkbook.FileFormat
    Case Is = 51
        Ext = "Libro de Excel (*.xlsx), *.xlsx"
     Case Is = 52
        Ext = "Libro de Excel habilitado para macros (*.xlsm), *.xlsm"
      Case Is = 56
        Ext = "Libro de de Excel 97 - 2003 (*.xls), *.xls"
End Select
'Se manda llamar el cuandro de diálogo Guardar como.
ChDir RutaArchivo
NombreArchivo = Application.GetSaveAsFilename(, FileFilter:=Ext, _
    Title:="EXCELeINFO: renombrar archivo actual")
Application.DisplayAlerts = False
'Si el nombre está en blanco o se presiona Cancelar, no se hace nada.
If NombreArchivo <> False Then
    'No realizar nada cuando los nombres sean iguales.
    If NombreArchivo = NombreCompleto Then
        MsgBox "No se realizó ningún cambio." & vbNewLine & vbNewLine & _
        "El nombre actual y el nombre nuevo son exactamente iguales.", vbInformation, "EXCELeINFO"
    Exit Sub
    Else
    'Si los nombre son diferentes, elimina el anterior y guarda el nuevo.
    ActiveWorkbook.SaveAs (NombreArchivo)
    Kill NombreCompleto
    Msj = "Se realizó el cambio de nombre satisfactoriamente:" & vbNewLine & vbNewLine
    Msj = Msj & "Nombre anterior: " & NombreCompleto & vbNewLine
    Msj = Msj & "Nombre nuevo: " & NombreArchivo
    MsgBox Msj, vbInformation, "EXCELeINFO"
    End If
End If
Exit Sub
Errores:
MsgBox "Ha ocurrido un error: " & vbNewLine & vbNewLine & err.Description, vbExclamation, "EXCELeINFO"
End Sub
Categories: Macros, vba Tags: , ,

Ejecutar consulta SQL desde Excel

November 8, 2011 15 comments

Hace algunos días me surgió la necesidad de extraer datos de unas bases de SQL a Excel, a lo cual me di a la tarea de buscar información al respecto. Cuál fue mi sorpresa que no existe mucha información al respecto. Encontré un ejemplo de ejecutar consulta SQL desde Excel del cual tomé el código que realiza la función y adecué un formulario para que sea más amigable la consulta.

Cómo funciona?

El ejemplo funciona si se tiene una cadena de conexión a SQL, y aunque no está probado para MySql no dudo que también funcione, sólo modificando la cadena.

Se muestra un formulario donde se especifica el nombre del servidor, de la base de datos, así como el usuario y la contraseña, además de un espacio para se que introduzca la sentencia SQL a ejecutar.

image

Consideraciones

Se requieren conocimientos básicos de SQL para armar la consulta, así como un servidor SQL local o en red.

Código

Private Sub CommandButton1_Click()
'Llamas la función Ejecutar
Cells.ClearContents
Call Ejecutar(Sheets(2).Range("consulta"), "Hoja1")
End Sub
Function Ejecutar(Sql As String, Hoja As String)
    On Error GoTo ErrorHandler
    Dim cn As Object
    ' crea un objeto Connection
    Set cn = CreateObject("ADODB.Connection")
    ' IMPORTANTE: Indicar la cadena de conexión a usar
    servidor = Sheets(2).Range("servidor")
    base = Sheets(2).Range("base")
    Usuario = Sheets(2).Range("usuario")
    pass = Sheets(2).Range("pass")
    Conexion = "Provider=SQLOLEDB.1;" & _
               "Password=" & pass & ";" & _
               "Persist Security Info=True;" & _
               "User ID=" & Usuario & ";" & _
               "Initial Catalog=" & base & ";" & _
               "Data Source=" & servidor
    'cn.ConnectionString = "Provider=SQLOLEDB.1;Password=s3cr3t0;Persist Security Info=True;User ID=sa;Initial Catalog=Cobranza;Data Source= 192.168.2.6"
    cn.ConnectionString = Conexion
    ' verifica que los parámetros no estén vacios
    If Sql <> vbNullString And Hoja <> vbNullString Then
        ' variable para al rec de ado
        Dim rst As Object
        ' abre la conexión a la base de datos
        cn.Open
        ' crea un nuevo objeto recordset
        Set rst = CreateObject("ADODB.Recordset")
        ' Ejecuta el sql para llenar el recordset
        rst.Open Sql, cn, 1, 3
        ' variables para los indices de las filas y columnas
        c = 0
        f = 0
        ' recorre las columnas, añade el nombre del campo al encabezado
        For i = 0 To rst.Fields.Count - 1
            Sheets(1).Range(Chr(i + 65) & f + 1).Value = rst.Fields(i).Name
        Next
        f = f + 1
        ' recorre todo el recordset hasta el final
        Do While Not rst.EOF
            ' recorre los campos en el registro actual del recordset para recuperar el dato
            For i = 0 To rst.Fields.Count - 1
                ' añade el valor a la celda
                Sheets(1).Range(Chr(c + 65) & _
                                f + 1).Value = rst.Fields(c)
                c = c + 1
            Next
            ' resetea el indice de las columnas
            c = 0
            ' Referencia al registro actual (incrementa )
            f = f + 1
            ' Siguiente registro
            rst.MoveNext
        Loop
        ' cierra y descarga las referencias
        On Error Resume Next
        rst.Close
        cn.Close
        Set cn = Nothing
        Set rst = Nothing
    End If
    Call Macro1
    Exit Function
ErrorHandler:
    MsgBox "Ha ocurrido un error: " & Err.Description, vbExclamation, "EXCELeINFO"
End Function

:: Descargar EXCELeINFO – Ejecutar consulta SQL desde Excel

Categories: Excel, Macros, Trucos, vba Tags: , , , , ,

Conectar Excel a Access, MySql y SQL

February 8, 2011 42 comments

Twittear este post Compartir en Facebook

En esta ocasión comparto 3 archivos que actualmente utilizo para dar de alta datos a bases de datos de Access, SQL y MySql desde Excel. Lo importante es saber exactamente el nombre de la base de datos, la tabla, y en el caso de SQL y MySql, el servidor, usuario y contraseña.

Comparto las macros que nos permiten hacer la tarea antes mencionada, aunque los archivos adjuntos son completamente funcionales.

Excel a Access

Sub exportaraccess()
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, n As Long
    Dim nfila As String
    '
    On Error GoTo Errores
    If Range("a2") = "" Or Range("b2") = "" Or Range("c2") = "" Or Range("d2") = "" Or Range("e2") = "" Then
        MsgBox prompt:="No hay datos para exportar", Buttons:=vbOKOnly + vbCritical, Title:="Campos vacios"
        Exit Sub
    End If
    '
    Set cn = New ADODB.Connection
    cn.Open "provider=microsoft.jet.oledb.4.0; " & "data source=" & ThisWorkbook.Path & "\" & shtListas.Range("rngBase") & ".MDB;"
    'cn.Open "provider=microsoft.jet.oledb.4.0; " & "data source=" & ThisWorkbook.Path & "\GUION.MDB;"
    Set rs = New ADODB.Recordset
    rs.Open shtListas.Range("rngTabla"), cn, adOpenKeyset, adLockOptimistic, adCmdTable
    n = 2
    Do While Range("a" & n) <> Empty
        With rs
            .AddNew
            .Fields("Nombre") = Range("a" & n).Value
            .Fields("Cuenta") = Range("b" & n).Value
            .Fields("Password") = Range("c" & n).Value
            .Fields("Permisos") = Range("d" & n).Value
            .Fields("Campana") = Range("e" & n).Value
            .Fields("Supervisor") = Range("f" & n).Value
            .Fields("Monitoreos") = Range("g" & n).Value
            .Fields("Estatus") = Range("h" & n).Value
            .Fields("Nivel") = Range("i" & n).Value
            .Fields("Tipo") = Range("j" & n).Value
            .Fields("Grupo") = Range("k" & n).Value
            .Fields("No Empleado") = Range("l" & n).Value
            .Fields("Fecha Ingreso") = Date
        End With
        n = n + 1
    Loop
    With rs
        .AddNew
        .Fields("Nombre") = Range("a" & n).Value
        .Fields("Cuenta") = Range("b" & n).Value
        .Fields("Password") = Range("c" & n).Value
        .Fields("Permisos") = Range("d" & n).Value
        .Fields("Campana") = Range("e" & n).Value
        .Fields("Supervisor") = Range("f" & n).Value
        .Fields("Monitoreos") = Range("g" & n).Value
        .Fields("Estatus") = Range("h" & n).Value
        .Fields("Nivel") = Range("i" & n).Value
        .Fields("Tipo") = Range("j" & n).Value
        .Fields("Grupo") = Range("k" & n).Value
        .Fields("No Empleado") = Range("l" & n).Value
        .Fields("Fecha Ingreso") = Date
    End With
    '
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    '
    MsgBox prompt:="Los datos fueron enviados correctamente", Buttons:=vbOKOnly, Title:="DATOS EXPORTADOS"
    Range("a2").Activate
    '
    If [a3] = Empty Then
        Range("a2", Selection.End(xlToRight)).ClearContents
        Exit Sub
    End If
    nfila = Range("A65535").End(xlUp).Row
    '    Range("a2:F" + nfila).ClearContents
    Exit Sub
Errores:
    MsgBox Err.Description & vbNewLine & vbNewLine & "Recuerda que el archivo debe estar en la misma ruta de la base de datos.", vbCritical, empresa
End Sub
Sub exportaraccess()
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, n As Long
    Dim nfila As String
    '
    On Error GoTo Errores
    If Range("a2") = "" Or Range("b2") = "" Or Range("c2") = "" Or Range("d2") = "" Or Range("e2") = "" Then
        MsgBox prompt:="No hay datos para exportar", Buttons:=vbOKOnly + vbCritical, Title:="Campos vacios"
        Exit Sub
    End If
    '
    Set cn = New ADODB.Connection
    cn.Open "provider=microsoft.jet.oledb.4.0; " & "data source=" & ThisWorkbook.Path & "\" & shtListas.Range("rngBase") & ".MDB;"
    'cn.Open "provider=microsoft.jet.oledb.4.0; " & "data source=" & ThisWorkbook.Path & "\GUION.MDB;"
    Set rs = New ADODB.Recordset
    rs.Open shtListas.Range("rngTabla"), cn, adOpenKeyset, adLockOptimistic, adCmdTable
    n = 2
    Do While Range("a" & n) <> Empty
        With rs
            .AddNew
            .Fields("Nombre") = Range("a" & n).Value
            .Fields("Cuenta") = Range("b" & n).Value
            .Fields("Password") = Range("c" & n).Value
            .Fields("Permisos") = Range("d" & n).Value
            .Fields("Campana") = Range("e" & n).Value
            .Fields("Supervisor") = Range("f" & n).Value
            .Fields("Monitoreos") = Range("g" & n).Value
            .Fields("Estatus") = Range("h" & n).Value
            .Fields("Nivel") = Range("i" & n).Value
            .Fields("Tipo") = Range("j" & n).Value
            .Fields("Grupo") = Range("k" & n).Value
            .Fields("No Empleado") = Range("l" & n).Value
            .Fields("Fecha Ingreso") = Date
        End With
        n = n + 1
    Loop
    With rs
        .AddNew
        .Fields("Nombre") = Range("a" & n).Value
        .Fields("Cuenta") = Range("b" & n).Value
        .Fields("Password") = Range("c" & n).Value
        .Fields("Permisos") = Range("d" & n).Value
        .Fields("Campana") = Range("e" & n).Value
        .Fields("Supervisor") = Range("f" & n).Value
        .Fields("Monitoreos") = Range("g" & n).Value
        .Fields("Estatus") = Range("h" & n).Value
        .Fields("Nivel") = Range("i" & n).Value
        .Fields("Tipo") = Range("j" & n).Value
        .Fields("Grupo") = Range("k" & n).Value
        .Fields("No Empleado") = Range("l" & n).Value
        .Fields("Fecha Ingreso") = Date
    End With
    '
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
    '
    MsgBox prompt:="Los datos fueron enviados correctamente", Buttons:=vbOKOnly, Title:="DATOS EXPORTADOS"
    Range("a2").Activate
    '
    If [a3] = Empty Then
        Range("a2", Selection.End(xlToRight)).ClearContents
        Exit Sub
    End If
    nfila = Range("A65535").End(xlUp).Row
    '    Range("a2:F" + nfila).ClearContents
    Exit Sub
Errores:
    MsgBox Err.Description & vbNewLine & vbNewLine & "Recuerda que el archivo debe estar en la misma ruta de la base de datos.", vbCritical, empresa
End Sub

Excel a MySql (será necesario descargar el driver 5.1 de MySql)

Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset
'
Function ExcelMySql()
    On Error GoTo err
    Set oConn = New ADODB.Connection
    oConn.Open "DRIVER={MySQL ODBC 5.1 Driver};" & _
               "SERVER=100.1.11.11;" & _
               "DATABASE=bd_database;" & _
               "USER=user;" & _
               "PASSWORD=pass;" & _
               "Option=3"
    Exit Function
err:
    MsgBox "Se ha producido el siguiente error: " & err.Description, vbInformation, ActiveWorkbook.Name
End Function
'
Function esc(txt As String)
    esc = Trim(Replace(txt, "'", "\'"))
End Function
'
'
Function InsertData()
    On Error GoTo Er
    'Se elimina la llamada a la función de conexión a la base de datos para hacerlo cuando inicie el archivo
    ' Call ConnectDB
    Set rs = New ADODB.Recordset
    sFunction = Application.WorksheetFunction.CountA(Range("A:A"))
    '
    With shInsertData
        For rowCursor = 2 To sFunction
            strSQL = "INSERT INTO tbl_cat_usuarios (ID_txtusuariotelsys, txt_clavetelsys, txt_nombre, txt_apepat, txt_apemat, bin_statusactivo, bin_nivel) " & _
                     "VALUES ('" & esc(.Cells(rowCursor, 1)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 2)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 3)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 4)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 5)) & "', " & _
                     esc(.Cells(rowCursor, 6)) & ", " & _
                     esc(.Cells(rowCursor, 7)) & ")"
            '
            'strSQL = "INSERT INTO tutorial (title, author, price) " & _
             "VALUES ('" & esc(.Cells(rowCursor, 1)) & "', " & _
             "'" & esc(.Cells(rowCursor, 2)) & "', " & _
             esc (.Cells(rowCursor, 3)) & ")"
            rs.Open strSQL, oConn, adOpenDynamic, adLockOptimistic
        Next
    End With
    MsgBox "Exito", vbInformation
    Exit Function
Er:
    MsgBox "Error: " & err.Description, vbInformation, ActiveWorkbook.Name
End Function

Excel a SQL

Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset
'
Function ConnectDB()
    On Error GoTo err
    Set oConn = New ADODB.Connection
    oConn.Open "Provider=SQLOLEDB.1;" & _
               "Password=pass;" & _
               "Persist Security Info=True;" & _
               "User ID=user;" & _
               "Initial Catalog=BASE;" & _
               "Data Source=100.1.111.11"
    MsgBox "Éxito al conectarse a la base de datos", vbInformation, "1"
    Exit Function
err:
    MsgBox "Se ha producido el siguiente error: " & err.Description, vbInformation, ActiveWorkbook.Name
End Function
'
Function esc(txt As String)
    esc = Trim(Replace(txt, "'", "\'"))
End Function
'
'
Function InsertData()
    On Error GoTo Er
    'Se elimina la llamada a la función de conexión a la base de datos para hacerlo cuando inicie el archivo
    ' Call ConnectDB
    Set rs = New ADODB.Recordset
    sFunction = Application.WorksheetFunction.CountA(Range("A:A"))
    '
    With shInsertData
        For rowCursor = 2 To sFunction
            strSQL = "INSERT INTO tbl_operador (ID, txt_nombre, txt_apepat, txt_apemat, txt_tipocuenta, bit_activo, txt_rol, pws_contra) " & _
                     "VALUES ('" & esc(.Cells(rowCursor, 1)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 2)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 3)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 4)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 5)) & "', " & _
                     "'" & esc(.Cells(rowCursor, 6)) & "', " & _
                     esc(.Cells(rowCursor, 7)) & ", " & _
                     "'" & esc(.Cells(rowCursor, 8)) & "' )"
            '
            rs.Open strSQL, oConn, adOpenDynamic, adLockOptimistic
        Next
    End With
    MsgBox "Las claves fueron dadas de alta correctamente.", vbInformation, "EXCELeINFO"
    Exit Function
Er:
    MsgBox "Error: " & err.Description, vbCritical, "EXCELeINFO"
End Function

:: Descargar zip con ejemplos

Categories: Bases de datos, Excel, vba Tags: , , , , ,