Hola a todos tengo que exportar en un archivo de texto, a una tabla con en la cual realice este archivo en ADO 2.5 pero ahora lo quiero en DAO en mi codigo Ado Funciona a las mil maravilla y es asi:
' -- Variables para la conexión y el recordset
Private cn As New ADODB.Connection
Private rst As New ADODB.Recordset
' --------------------------------------------------------------------------------
' \\ -- Función que exporta el recordset a un archivo de texto
' --------------------------------------------------------------------------------
Public Function Exportar_Recordset( _
rs As Object, _
Optional sFileName As String, _
Optional sDelimiter As String = " ", _
Optional bPrintField As Boolean = False) As Boolean
Dim iFreeFile As Integer
Dim iField As Long
Dim i As Long
Dim obj_Field As ADODB.Field
On Error GoTo error_handler:
Screen.MousePointer = vbHourglass
' -- Otener número de archivo disponible
iFreeFile = FreeFile
' -- Crear el archivo
Open sFileName For Output As #iFreeFile
With rs
iField = .Fields.Count - 1
On Error Resume Next
' -- Primer registro
.MoveFirst
On Error GoTo error_handler
' -- Recorremos campo por campo y los registros de cada uno
Do While Not .EOF
For i = 0 To iField
' -- Asigna el objeto Field
Set obj_Field = .Fields(i)
' -- Verificar que el campo no es de ipo bunario o un tipo no válido para grabar en el archivo
If isValidField(obj_Field) Then
If i < iField Then
If bPrintField Then
' -- Escribir el campo y el valor
Print #iFreeFile, obj_Field.Name & ":" & obj_Field.Value & sDelimiter;
Else
' -- Guardar solo el valor sin el campo
Print #iFreeFile, obj_Field.Value & sDelimiter;
End If
Else
If bPrintField Then
' -- Escribir el nombre del campo y el valor de la última columna ( Sin delimitador y sin punto y coma para añadir nueva línea )
Print #iFreeFile, obj_Field.Name & ": " & obj_Field.Value
Else
' -- Guardar solo el valor sin el campo
Print #iFreeFile, obj_Field.Value
End If
End If
End If
Next
' -- Mover el cursor al siguiente registro
.MoveNext
Loop
End With
' -- Cerrar el recordset
rst.Close
Exportar_Recordset = True
Screen.MousePointer = vbDefault
Close #iFreeFile
Exit Function
error_handler:
On Error Resume Next
Close #iFreeFile
rst.Close
Screen.MousePointer = vbDefault
End Function
' ----------------------------------------------------------------------------------------------
' -- Si el campo es nulo ( binario, o tipo desconocido etc..) devuelve False para no añadir el dato
' ----------------------------------------------------------------------------------------------
Private Function isValidField(obj_Field As ADODB.Field) As Boolean
With obj_Field
On Error GoTo error_handler
Select Case obj_Field.Type
Case adBinary, adIDispatch, adIUnknown, adUserDefined
isValidField = False
' -- Campo válido
Case Else
isValidField = True
End Select
End With
Exit Function
error_handler:
End Function
' ----------------------------------------------------------------------------------------------
' -- Si el campo es nulo ( binario, o tipo desconocido etc..) devuelve False para no añadir el dato
' ----------------------------------------------------------------------------------------------
Private Sub Command1_Click()
Dim cadena As String
' -- Cadena de conexión
cadena = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Archivos de programa\Microsoft Visual Studio\VB98\nwind.MDB;Persist Security Info=False"
' -- Abrir base de datos
cn.Open cadena
' -- Abrir el recordset
rst.Open "SELECT * FROM clientes", cn, adOpenKeyset, adLockOptimistic
' -- Enviar el recordset, y el path del archivo donde se creará y el
' -- delimitador en este caso un tabulador con la constante VbTab
Call Exportar_Recordset(rst, "c:\archivo.txt", vbTab)
' -- Cierra la Base de datos
If cn.State = adstateopen Then cn.Close
End Sub
' ---------------------------------------------------------------------------------
' \\ -- Cerrar la base de datos y el recordset al finalizar
' ---------------------------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
If Not rst Is Nothing Then
If rst.State = adstateopen Then rst.Close
Set rst = Nothing
End If
If Not cn Is Nothing Then
If cn.State = adstateopen Then cn.Close
Set cn = Nothing
End If
End Sub
pero lo paso a una libreria mas Vieja que es Dao y el codigo no muestra los datos en el archivo
Global Espacio As Workspace
Global Base As Database
Global SQL As String
Public Sub IniciarConexion()
Ruta = App.Path
Set Espacio = CreateWorkspace("ConeccionBingo", "", "", dbUseODBC)
'Set Base = Espacio.OpenDatabase("Bingo", dbOpensnatshop)
Set Base = Espacio.OpenDatabase("Bingo", _
dbDriverNoPrompt, False, _
"ODBC;DATABASE=eds;UID=1;PWD=B3151J0885F8983LSKB;DSN=Bingo")
End Sub
Bueno agradezco sus Valiosas Ayudas
