VBA - Crear una tabla en Access con un RecordSet

Question

Buenas tardes:

De antemano muchas gracias por los aportes que me puedan hacer. A continuación les planteo la situación que debo resolver en VBA.

1. Creo una conexión y un recordset con ADO ----> (dbase IV).
   • Dim Conn as ADODB.Connection
   • Dim Rs As ADODB.Recordset
2. Abro la conexión y creo el Recordset

Todo esto va muy bien, por el momento retorno el "RecordSet" a una hoja en excel, pero ahora necesito crear una "Tabla" en una base de datos de ACCESS.

Como puedo crear una nueva tabla en una base de datos en Access con este RecordSet (Dbase IV).

Aclaro que el RecordSet está recuperando muy bien la información solo necesito resolver el paso de crear la tabla en Access...

Saludos...

Answer 1

Puedes usar esta función :

Private Sub Crear_Tabla() 

Dim Cn As ADODB.Connection 
Dim Sql As String 
Dim NombreTabla As String 

Set Cn = New ADODB.Connection ' abrimos la conexión a la base de datos 

Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Persist Security Info=False;" & _ 
        "Data Source=" & App.Path & "\NombreBD.mdb" 

NombreTabla = "MiTabla" ' o cualquier nombre de tabla que quieras poner 


' En esta sentencia tienes que definir la estructura de campis de la tabla que quieres crear:

Sql = "CREATE TABLE " & NombreTabla & "(" & _ 
                  "Id COUNTER CONSTRAINT miIndice UNIQUE, " & _ 
                  "Cliente NUMBER NOT NULL, " & _ 
                  "Fecha DATE NOT NULL, " & _ 
                  "Nombre VARCHAR(40) ," & _ 
                  "Numero NUMBER ," & _ 
                  "Activo YESNO )" 

Cn.Execute Sql, , adCmdText 

End Sub 

---

Saludos, Javier J

Answer 2

Buenos días Javier:

Muchas gracias por tu pronta respuesta.

Hasta el momento a través de VBA guardo los archivos .DBF como .xlsx y luego los importo a Access. Lo que pretendo hacer es crear un RecordSet e importar estos datos como una tabla de Access.

Utilizo Windows 8 64bits y Office 2013 64bits (Access 2013 64bits no tiene soporte para Dbase)

A continuación te muestro el código que estoy utilizando:

Option Explicit
Global cnnActiva As New ADODB.Connection
Global RecSet As New ADODB.Recordset
Const HKEY_LOCAL_MACHINE = &H80000002



Sub ConsultaDbase()
    Call CheckMySQL
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    MsgBox "Inicia proceso"
    ConnDbase "Hoja1", "TbBancos", "Bancos"
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    Application.StatusBar = ""
    MsgBox "Termina proceso"
End Sub


Public Function ConnDbase(strHoja As String, strTabla As String, strTbAccess As String)
    Dim j As Long
    Dim registros() As Variant

    Application.StatusBar = "Abriendo la BD"
    Call AbreDBF
    Application.StatusBar = "Abriendo la tabla"
    With RecSet
        .CursorType = adOpenForwardOnly
        .LockType = adLockOptimistic
        .Open "SELECT * FROM " & strTbAccess & " ;", cnnActiva
    End With

' En este punto ya encuentro el RecordSet que obtuve de la consulta a una tabla Dbase con la información cargada

' Con el siguiente código copio el RecordSet en una hoja de excel.

    registros = RecSet.GetRows()
    Application.StatusBar = "Copiando los encabezados"
    With Sheets(strHoja)
        For j = 0 To RecSet.Fields.Count - 1
            .Cells(1, j + 1).Value = RecSet.Fields(j).Name
        Next
        Application.StatusBar = "Copiando los registros"
        .Range("A2").CopyFromRecordset RecSet
    End With

' Necesito cambiar este código para crear una Tabla en Access con la información contenida en el RecordSet

    Application.StatusBar = "Cerrando la BD"
    Call CierraBD
    Range("A1").Select
End Function


Sub AbreDBF()
  Dim dbffile As String
  dbffile = "C:\ARCO\PROYECTO"
  Set cnnActiva = New ADODB.Connection
  cnnActiva.Open "DRIVER={" & Range("OdbcDbase") & "};ReadOnly=True;" & _
      "DBQ=" & dbffile & ";"
End Sub


Public Sub CierraBD()
    If RecSet.Fields.Count Then
        RecSet.Close
        Set RecSet = Nothing
    End If
    cnnActiva.Close
    Set cnnActiva = Nothing
End Sub

Saludos...

Answer 3

conseguiste resolverlo?