Archive

Posts Tagged ‘MySql’

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.

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: , , , , ,