
12-04-14, 17:49
|
Όνομα: Γιώργος Έκδοση λογισμικού Office: Ms-Office 2010 Γλώσσα λογισμικού Office: Ελληνική, Αγγλική | | Εγγραφή: 18-06-2010
Μηνύματα: 3.573
| |
Καλησπέρα
Νάσια, στο επισυναπτόμενο αρχείο:
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».
Μπορείς να το αλλάξεις τροποποιώντας τη σχετική γραμμή του κώδικα.
Γιώργος
|