Leopoldo Quintana

Conectar Excel a Access, MySql y SQL
February 8, 2011 sergioacamposh Leave a comment Go to comments
[pic] [pic]
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") = "" ThenMsgBox 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("NoEmpleado") = 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
ExitSub
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=" &...