microsoft.jet.oledb.4.0 Para Windoms 7 64 bits y demas pc
publicado
Buenas tardes mis estimados Expertos,
con la siguiente duda y pidiendo tu apreciable ayuda, encontre en internet este archivo de excel que llama una consulta de acces me funciona perfectamente en xp pero al ponerla en accion en windows y de 32 y 64 bits me arroja un error, estube leyendo e investigando y segun no hay otro provider para estos SO ya que ste archivo lo pretendo compartir a diferentes usuarios con diferentes SO, por lo que por tal motivo solicito su gran ayuda de haber forma de poder solucionar este detalle.
Adjunto codigo que sirve para consultar access y archivos:
Buenas tardes mis estimados Expertos,
con la siguiente duda y pidiendo tu apreciable ayuda, encontre en internet este archivo de excel que llama una consulta de acces me funciona perfectamente en xp pero al ponerla en accion en windows y de 32 y 64 bits me arroja un error, estube leyendo e investigando y segun no hay otro provider para estos SO ya que ste archivo lo pretendo compartir a diferentes usuarios con diferentes SO, por lo que por tal motivo solicito su gran ayuda de haber forma de poder solucionar este detalle.
Adjunto codigo que sirve para consultar access y archivos:
Private Sub cmdimportar_Click()
Dim sError As String
Dim ruta As String
Dim base_de_datos As String
Dim Tabla As String
Dim celda_inicial As String
Dim i As Integer
Dim sWSQL As String
ruta = ThisWorkbook.Path
base_de_datos = "Reporte_datos_exportados.mdb"
Tabla = "Reporte_Diario"
celda_inicial = "a10"
'**************************************************
'Ocultamos el procedimiento
Application.ScreenUpdating = False
'Esta parte del codigo si queremos bloquear la pagina cuando nos traiga los datos.
'ActiveSheet.Protect Password:="xxxxxxxx", UserInterfaceOnly:=True
'Capturamos los posibles errores
On Error GoTo HayError
'Creamos el objeto conexión
sError = "No se ha podido abrir la base de datos."
Set Conn = New ADODB.Connection
'Nos conectamos a la base de datos
Conn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & ruta & "\" & base_de_datos)
'Montamos la sentencia SQL para
'mostrar todos los datos de la tabla
total_filas = Rows.Count - Range(celda_inicial).Row
sql = "Select * from " & Tabla
If Range("H7") <> "" And Range("H5") = "" Then
Range("H5") = Range("H7")
Range("H7") = ""
End If
If Range("H5") <> "" Then
If Range("H7") <> "" Then
sWSQL = "(Fecha_exportado BETWEEN " & _
CLng(Range("H5")) & " AND " & CLng(Range("H7")) & ")"
Else
sWSQL = "(Fecha_exportado = " & CLng(Range("H5")) & ")"
End If
End If
If Range("E5") <> "" Then
sWSQL = sWSQL & IIf(sWSQL <> "", " AND", "") & " (Identificacion = """ & Range("E5") & """)"
Range("A11").Select
End If
If Range("E7") <> "" Then
sWSQL = sWSQL & IIf(sWSQL <> "", " AND", "") & " (Numero_solicitud = """ & Range("E7") & """)"
Range("B11").Select
End If
If Range("B5") <> "" Then
sWSQL = sWSQL & IIf(sWSQL <> "", " AND", "") & " (Lote = """ & Range("B5") & """)"
Range("D11").Select
End If
sql = sql & IIf(sWSQL <> "", " WHERE (" & sWSQL & ")", "")
'Abrimos la base de datos
'Creamos el objeto recordset
sError = "Hay problemas con la tabla " & Tabla & " de la base de datos"
Set rs = New ADODB.Recordset
rs.Open sql, Conn, adOpenStatic, adLockOptimistic
'BORRAMOS LOS POSIBLES DATOS ANTERIORES
Range(celda_inicial).CurrentRegion.ClearContents
'Títulos de las columnas
With Range(celda_inicial)
For i = 0 To rs.Fields.Count - 1
.Offset(, i) = UCase(rs.Fields(i).Name)
Next
.CurrentRegion.Font.Bold = True
End With
'contamos los registros totales
registros_totales = rs.RecordCount
If registros_totales = 0 Then
sError = "No Se Encontro Ningun Registro con Esa Especificacion."
Error 65535
End If
'Copiar el resultado
sError = "Hay problemas para grabar los datos en la hoja."
With Range(celda_inicial).Offset(1)
.CopyFromRecordset rs, total_filas
End With
sError = ""
'cerramos la conexión
Conn.Close
'limpiamos los objetos
Set Conn = Nothing
Set rs = Nothing
'Mostramos el procedimiento
Application.ScreenUpdating = True
'Resultado de la importación
HayError:
Application.ScreenUpdating = True
If sError = "" Then
If registros_totales <= total_filas Then
sError = " Se importaron correctamente todos los registros " & _
Chr(13) & " de la base de datos """ & base_de_datos & """, y de la tabla " & _
Chr(13) & " llamada """ & Tabla & """. " & _
Chr(13) & Chr(13) & " Se han importado los " & registros_totales & " registros de la tabla. " & _
Chr(13) & Chr(13)
Else
sError = " Se importaron correctamente solo algunos registros " & _
Chr(13) & " de la base de datos """ & base_de_datos & """, y de la tabla " & _
Chr(13) & " llamada """ & Tabla & """. " & _
Chr(13) & Chr(13) & " En concreto solo se importaron " & total_filas & " registros, de " & _
Chr(13) & " los " & registros_totales & " registros disponibles. " & _
Chr(13) & Chr(13)
End If
End If
MsgBox Chr(13) & sError, vbOKOnly, "TERMINADO"
End Sub
cualquier detalle quedo a sus órdenes.
Saludos cordiales
Reporte_en_Blanco.zip