Saltar al contenido
View in the app

A better way to browse. Learn more.

Ayuda Excel

A full-screen app on your home screen with push notifications, badges and more.

To install this app on iOS and iPadOS
  1. Tap the Share icon in Safari
  2. Scroll the menu and tap Add to Home Screen.
  3. Tap Add in the top-right corner.
To install this app on Android
  1. Tap the 3-dot menu (⋮) in the top-right corner of the browser.
  2. Tap Add to Home screen or Install app.
  3. Confirm by tapping Install.

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:

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

Featured Replies

No hay posts para mostrar

Archivado

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

Configure browser push notifications

Chrome (Android)
  1. Tap the lock icon next to the address bar.
  2. Tap Permissions → Notifications.
  3. Adjust your preference.
Chrome (Desktop)
  1. Click the padlock icon in the address bar.
  2. Select Site settings.
  3. Find Notifications and adjust your preference.