none
Exportar archiivo de Texto en Dao 3.5 RRS feed

  • Pregunta



  • 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



    viernes, 25 de septiembre de 2009 23:44