[kapetang]

Καλησπέρα

Νάσια, στο επισυναπτόμενο αρχείο:

1) Έχω προσθέσει το ερώτημα qryExport, το οποίο περιέχει τα δεδομένα που θα εξαχθούν στο αρχείο κειμένου.

2) Τη φόρμα frmExport.

Πατώντας το κουμπί [Εξαγωγή Δεδομένων] της φόρμας, εκτελείται ο παρακάτω κώδικας που υλοποιεί το ζητούμενο.

Private Sub cmdExport_Click()
    'Απαιτείται αναφορά στο Microsofrt Scripting Runtime
    
    Dim numRec As Long, rsE As DAO.Recordset, rsP As DAO.Recordset
    Dim strSQL As String, strExit As String
    Dim fso As Object, oFile As Object, strFile As String
    Dim j As Long, strExport As String
    
    On Error GoTo Err_Trap
    
    'Εδώ καθορίζεται το αρχείο στο οποίο θα εξαχθούν τα δεδομένα
    strFile = "C:\EXETASEIS.txt"
    
    strSQL = "SELECT DISTINCT [Kwdikos_Exetashs],[Perigrafh_Exetashs] FROM qryExport ORDER BY Perigrafh_Exetashs"
    Set rsE = CurrentDb.OpenRecordset(strSQL)
    
    If rsE.RecordCount > 0 Then
        numRec = rsE.RecordCount + DCount("*", "qryExport") * 3
        ReDim strrec(1 To numRec) As String
        rsE.MoveFirst
        
        'Εδώ λαμβάνονται τα δεδομένα από το ερώτημα qryExport
        'και αποθηκεύονται στα στοιχεία του μονοδιάστατου πίνακα strRec()
        Do Until rsE.EOF
            strSQL = "SELECT [Perigrafh_Exetashs],[Onomateponymo], [Dieythinsh] ,[Thlefwno] " _
            & "FROM qryExport WHERE [Kwdikos_Exetashs]=" & rsE![Kwdikos_Exetashs] _
            & " ORDER BY [Onomateponymo]"
            Set rsP = CurrentDb.OpenRecordset(strSQL)
            rsP.MoveFirst
            j = j + 1: strrec(j) = "#00 " & rsP![Perigrafh_Exetashs] & " #00"
            Do Until rsP.EOF
                j = j + 1: strrec(j) = "#01 Ονοματεπώνυμο: " & rsP![Onomateponymo] & " #01"
                j = j + 1: strrec(j) = "#02 Διεύθυνση: " & rsP![Dieythinsh] & " #02"
                j = j + 1: strrec(j) = "#02 Τηλ: " & rsP![Thlefwno] & " #02"
                rsP.MoveNext
            Loop
            rsP.Close
            rsE.MoveNext
        Loop
        
        'Όλα τα στοιχεία του πίνακα ενώνονται στο string strExport
        'και το string αποθηκεύεται στο αρχείο κειμένου strFile
        
        strExport = Join(strrec, vbCrLf)
        Set fso = CreateObject("scripting.FileSystemObject")
        Set oFile = fso.CreateTextFile(strFile)
        oFile.WriteLine strExport
        MsgBox "Η εξαγωγή των δεδομέμων ολοκληρώθηκε." & vbCrLf & "Αρχείο: " & strFile
    End If
    
Exit_Sub:
On Error Resume Next
    oFile.Close
    rsE.Close
    rsP.Close
    Set fso = Nothing
    Exit Sub
    
Err_Trap:
    MsgBox "Error: #" & Err.Number & vbCrLf & Err.Description, "Error"
    Resume Exit_Sub
End Sub

Το αρχείο στο οποίο αποθηκεύονται, ως κείμενο, τα δεδομένα είναι το «C:\EXETASEIS.txt».

Μπορείς να το αλλάξεις τροποποιώντας τη σχετική γραμμή του κώδικα.

Γιώργος