Saltar al contenido

microsoft.jet.oledb.4.0 Para Windoms 7 64 bits y demas pc


jams89

Recommended Posts

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:

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

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.