Visual Basic - AYUDA alguien MEGA EXPERTO en consultas...

Genere un modulo para pasar de dbase a access pero el problema es que cuando en dbase hay mas de 600 campos me manda un mensaje que dice recursos insuficientes...

QUIERO QUE ALGUIEN CON MAS ESPERIENCIA QUE YO ME AYUDE A RESOLVER EL PROBLEMA del ERROR... GRACIAS.

Si pueden ayudarme..
[email protected]

Bueno mi modulo trabaja de la siguiente manera:
teniendo una base en dbase con x numero de campos y Z numeros de registros, son pasados a access en una base que ya tengas creada en una tabla que contenga los campos requeridos.

Por ejemplo si en dbase se tienen los campos:
C1, C2, C3, C4, ... C100

en access una tabla con los campos
C1, C10, C20, C30, C40, C50, C100

NOTA: Los campos deben ser con el mismo nombre en dbase y en access

bien lo unico que deben hacer es llamar a mi modulo
call ExpdedbaseaAccess(rutaorigen, NomTablaOrigen, RutaDestino, NomTablaDestino)



MI MODULO para el que le sirva

Public Sub ExpdedbaseaAccess(RutaOrigen As String, TablaOrigen As String, RutaDestino As String, TablaDestino As String)
'On Error GoTo error
'Bloquear Menus
' frmInicio.Image53.Picture = LoadPicture(App.Path & "ICOproc.ICO")

frmInicio.Enabled = False
'Verificar la existencias del archivo de Inicio
Dim osf As FileSystemObject
Set osf = New FileSystemObject
Dim arc1 As Boolean
Dim arc2 As Boolean
arc1 = osf.FileExists(RutaOrigen & "" & TablaOrigen & ".dbf")
arc2 = osf.FileExists(RutaDestino)
If arc1 = False Then
MsgBox "El archivo " & RutaOrigen & "" & TablaOrigen & ".dbf" & Chr(13) & "No fue encontrado", vbInformation + vbOKOnly, "No se puede continuar..."
Exit Sub
End If
If arc2 = False Then
MsgBox "El archivo " & RutaDestino & Chr(13) & "No fue encontrado", vbInformation + vbOKOnly, "No se puede continuar..."
Exit Sub
End If


'ABrir bases de datos sI9119
Dim base, baser As dao.Database
Dim tabla As dao.Recordset, tablar As dao.Recordset, tmun As dao.Recordset

'Set base = OpenDatabase(RutaOrigen, False, False, "dbase 5.0;")
'Set tabla = base.OpenRecordset(TablaOrigen, dbOpenTable)
'MsgBox tabla.RecordCount

'RutaDestino = App.Path & "ReportesExplotacion de BasesExplotacioninicio.mdb"
Set baser = OpenDatabase(RutaDestino, True)
Set tablar = baser.OpenRecordset("SELECT * FROM " & TablaDestino)

Dim a As Integer
Dim ncampo As String
Dim tcampo As String
'Dim n1 As String
Dim cadsql1 As Variant, cadsql2 As Variant, cadsql3 As Variant
cadsql1 = ""
cadsql2 = ""
cadsql3 = ""
With tablar
baser.Execute "delete * from " & TablaDestino & ";"

For a = 0 To tablar.Fields.Count - 1
ncampo = tablar.Fields(a).Name
If cadsql1 = "" Then
cadsql1 = ncampo
cadsql2 = TablaOrigen & "." & ncampo
Else
cadsql1 = cadsql1 & ", " & ncampo
cadsql2 = cadsql2 & ", " & TablaOrigen & "." & ncampo
End If
Next a
'Quitar coma del final
cadsql1 = Left(cadsql1, Len(cadsql1))
cadsql2 = Left(cadsql2, Len(cadsql2))
cadsql3 = "INSERT INTO [" & RutaDestino & "]." & TablaDestino & " ( " & cadsql1 & " ) SELECT " & cadsql2 & " FROM " & TablaOrigen & " IN '" & RutaOrigen & "'[dBASE 5.0;]"
frmInicio.Text2.Text = cadsql3
baser.Execute cadsql3
End With


'cerrar tablas y bases
'tabla.Close
tablar.Close
'tmun.Close
'base.Close
baser.Close

'frmInicio.Image53.Picture = LoadPicture(App.Path & "ICOien2.ICO")

'frmInicio.lbtabla.Caption = ""

Exit Sub
error:
If Err.Number = 3044 Then
MsgBox "No selecciono con que base trabajar" & Chr(13) & "Seleccione el menu utilerias" & Chr(13) & "Luego Ubicación de la base", vbInformation + vbOKOnly, "No se puede continuar..."
Else
MsgBox "Anote el error y consulte al administrador..." & Chr(13) & Err.Number & "-. " & Err.Description, vbCritical + vbOKOnly, "Contacte al administrador..."
End If
frmInicio.frmExpBDIniyMS.Visible = False
frmInicio.frmExpBDIniyMS.Enabled = False
frmInicio.Enabled = True
frmInicio.Visible = False
Modulo2.retardo (1)
frmInicio.Visible = True




End Sub

Hola Pedro como andas.

Mira yo en primer lugar usaria ADO en vez de DAO.

y en segundo lugar lo que tenes que hacer es abri una base y mientras la recorres agregar en la otra y eso se hace con un DO WHILE osea ...

DO WHILE NOT RS.BASE1(EOF) ' recorro la tabla mientras no sea el final

' agrego los datos a la base access

RSBASE1.MOVENEXT

LOOP

si no fui claro , mandame las bases que lo hago y te lo explico, ok?
escribime no hay drama

saludos

Saludos Christian

De hecho lo tengo asi pero el tiempo de proceso es de 10 minutos aproximadamente por base y son 15 bases

y con SQL se tarda 3 segunos por base

Ya te envie una base origen y una destino para que te des una idea del problema....

Estamos en contac...