Spalteninhalte aus ACCESS-DB in Textfile übergeben...

[-cta-]

guten morgen!

ich habe ein klitzekleines problemchen mit meinem projekt...

folgendes:

ich möchte aus einer ACCESS-Datenbank die Inhalte einer Spalte in ein Textfile schreiben... nennen wir die DB "Planung"... das Textfile Stichwort.

und zwar geordnet nach Werten.

die Werte sind z.B.

1544839
1788394
4993834
6998287
....

die Werte sollen nach der ersten Zahl geordnet werden. Im Textfile soll immer erst die "Kategorie" geschrieben werden also "(0) 1-9", danach der Inhalt "(1) Wert"



das textfile soll dann wie folgt aussehen:

(0) 1
(1) 1544839
(1) 1788394
(0) 2
(0) 3
(0) 4
(1) 4993834
(0) 5
(0) 6
(1) 6998287
(0) 7
(0) 8
(0) 9



nach dem ganzen soll die Dateiendung des textfiles in .swl umgeändert werden.

Bin für jede Hilfe sehr dankbar!

gruss,

-cta-

 

[ANI]

Hallo,

hier die Lösung Deines Problems:

Option Compare Database
Option Explicit

Const TextFile = "\Stichwort.swl"

Public Function SchreibeTextFile()
On Error GoTo Err_SchreibeTextFile
Dim Merke(1 To 9) As Boolean
Dim LastKategorie As Integer, AktKategorie As Integer, i%
Dim DB As Database
Dim RS As Recordset

Set DB = DBEngine(0)(0)
Set RS = DB.OpenRecordset("Select * from [Tabelle] Order By [Werte]")

If Not RS.EOF Then
'Sicherheitshalber noch einmal schließen
Close #1
'Vorbereiten und öffnen der Datei
Open DatenbankPath & TextFile For Output As #1
'Schleife abfragen
Do Until RS.EOF
AktKategorie = CInt(Mid(RS![Werte], 1, 1))
If (LastKategorie + 1) < AktKategorie Then
For i = (LastKategorie + 1) To (AktKategorie - 1)
Print #1, "(0) " & i
Next i
End If
If Merke(AktKategorie) Then
Print #1, "(1) " & RS![Werte]
Else
Print #1, "(0) " & AktKategorie
Print #1, "(1) " & RS![Werte]
'Sich merken, welche Kategorie gewesen ist
Merke(AktKategorie) = True
LastKategorie = AktKategorie
End If
RS.MoveNext
Loop
'Schlußprüfung bis Kategorie 9
If (LastKategorie + 1) < 9 Then
For i = (LastKategorie + 1) To (9)
Print #1, "(0) " & i
Next i
End If
Close #1
End If

Exit_SchreibeTextFile:
Exit Function

Err_SchreibeTextFile:
MsgBox Err & " - " & Error$
Resume Exit_SchreibeTextFile

End Function

Public Function DatenbankPath() As String
On Error GoTo Err_DatenbankPath
Dim i%

Dim DBo As Database
Set DBo = DBEngine(0)(0)

For i = Len(DBo.Name) To 1 Step -1
If Mid(DBo.Name, i, 1) = "\" Then
DatenbankPath = Mid(DBo.Name, 1, i)
Exit For
End If
Next i

Exit_DatenbankPath:
Exit Function

Err_DatenbankPath:
MsgBox Err & " - " & Error$
Resume Exit_DatenbankPath

End Function

Viel Spass

ANI