Sub TextAusgabe()
    Dim Datei As String
    Dim strSQL As String
    Dim RS As DAO.Recordset
    Dim DB As DAO.Database
    Dim Part As Variant
    Dim Parts As Variant
    Dim strDS As String
    Dim strAusgabe As String
    Dim i As Integer
    Dim Schalter As Boolean

    'Pfad der Ausgabedatei
    Datei = VBA.Environ("TEMP") & "\Ausgabe.txt"
    strSQL = "SELECT * FROM tblDaten"

    Close #1
    'Achtung Ausgabedatei wird durch jeden Prozeduraufruf überschrieben
    'Falls die Datei nicht existiert wird sie erstellt
    Open Datei For Output As #1

    Set DB = CurrentDb()
    Set RS = DB.OpenRecordset(strSQL, dbOpenDynaset)

    Do While Not RS.EOF
        strDS = ""
        For i = 0 To RS.Fields.Count - 1
            strDS = strDS & RS.Fields(i) & "|"
        Next i
        strDS = VBA.Mid(strDS, 1, (VBA.Len(strDS)) - 1)
        Parts = VBA.Split(strDS, "|")
        For Each Part In Parts
            If IsNumeric(Part) = False Then
                If VBA.Len(strAusgabe) > 0 Then
                    strAusgabe = VBA.Mid(strAusgabe, 1, (VBA.Len(strAusgabe)) - 1)
                    Print #1, strAusgabe
                End If
                strAusgabe = ""
                strAusgabe = Part & ";"
            Else
                strAusgabe = strAusgabe & Part & ";"
            End If
        Next Part
        RS.MoveNext
    Loop
    'Letzten Datensatz schreiben
    strAusgabe = VBA.Mid(strAusgabe, 1, (VBA.Len(strAusgabe)) - 1)
    Print #1, strAusgabe
    Close #1
    RS.Close
    Set RS = Nothing
    DB.Close
    Set DB = Nothing
End Sub

SELECT ID, Feld1, Feld2, Feld3, Feld4, 1 AS Sortierung
UNION
SELECT ID, Feld5, Feld6, Feld7, Feld8, 2 AS Sortierung
UNION
SELECT ID, Feld9, Feld10, Feld11, Feld12, 3 AS Sortierung
ORDER BY ID, Sortierung;

SELECT Feld1, Feld2, Feld3, Feld4
FROM qryMeineAbfrage;

DoCmd.TransferText