Access03 Daten aus DB in txtfile schreiben...

mr-otin

Mitglied
Hallo,

Ich schreibe Daten aus einer DB in ein Textfile. Nun moechte ich das die Daten bei ueberlaenge gekuerzt werden. Soll heissen

Zeichen pro Seite = 1600
Zeichen pro Zeile = 69

Leider funktioniert es nicht so, wie es soll. Ich bekomme zwar die Daten aus der DB, haenge ich aber eine Stringvariable zu tText an bringt er mir ein Runtime Error 5 (betreffende Zeile rot markiert). Das gleiche passiert auch wenn ich MaxZeichenProSeite auf 3 aendere und MaxZeichenProZeile so bestehen lasse. Was kann ich da machen?

hier mal der Code dafuer
Visual Basic:
Private Sub Command1_Click()
 
Dim MaxZeichenProSeite As Long
Dim MZpS As Long
Dim I As Long
Dim MaxZeichenProZeile As Long
Dim gText As String
Dim tText As String
 
MaxZeichenProSeite = 130
MaxZeichenProZeile = 25
 
tText = "Das ist ein beliebiger Text, welcher auf eine maximale Zeilen- und Seitenlänge begrenzt werden soll. Die Ausgabe erfolgt mittels DEBUG.PRINT und kann im Direktfenster betrachtet werden."
 
Do While Len(tText) > 0
    Do While Len(tText) > 0
    
        If Len(tText) >= MaxZeichenProZeile Then
            gText = Left$(tText, MaxZeichenProZeile)
            
                For I = MaxZeichenProZeile To 1 Step -1
                    If Mid$(gText, I, 1) = " " Then Exit For
                Next
            
            If MZpS + I - 1 > MaxZeichenProSeite Then
                tText = gText + tText
                Debug.Print "----- Seitenumbruch -----"
                MZpS = 0
                Exit Do
            End If
            
            MZpS = MZpS + I - 1
            
            gText = Left$(gText, I - 1)
            tText = Right$(tText, Len(tText) - I)
        
        Else
            gText = tText
            tText = ""
        End If
        Debug.Print gText
    
    Loop
Loop
End Sub
 
Zuletzt bearbeitet:
Wie gross ist denn dein I ? Soweit ich das richtig gesehen habe im Schlimmstenfall 1nämlich wenn kein Leerzeichen in der Zeile war. Dann machst du ein Left mit (i - 1 ) in deiner "roten" Zeile also mit 0 und das fehlert.
Grüsse bb
 
Hi Brainbyte,

Die Grösse von I bezieht er aus der For Schleife:

Visual Basic:
For I = MaxZeichenProZeile To 1 Step -1
    If Mid$(gText, I, 1) = " " Then Exit For
Next

Diese beträgt in dem Bsp. 25

best regards
Dave
 
aber nur wenn er ein Leerzeichen in deiner Zeile findet.

ich habe mal gerade versucht das nachzuvollziehen bekam aber leider den Fehler nicht.
Versuch doch mal mit "MID" statt mit Left$ deinen String zu verkürzen

Grüsse bb
 
Habe es mit Mid$ probiert, aber es funktioniert nicht. Genau das gleiche. Hier mal der Complete code. Ich beziehe daten aus einer Tabelle

Visual Basic:
Private Sub cmdLGData_Click()
 
'declaration of variables
 
    Dim cdb As Database
    Dim cdf As QueryDef, strSQL As String
    Dim PgCnt As Integer
    Dim TcmNumber, MyStr
    
    Dim MaxZeichenProSeite As Long
    Dim MZpS As Long
    Dim I As Long
    Dim MaxZeichenProZeile As Long
    Dim gText As String
    Dim tText As String
    Dim header As String
    Dim data As String
        
    Dim objOutlook As Object
    Dim objNameSpace As Object
    Dim objMailItem As Object
    Dim d As Date
    Set objOutlook = CreateObject("Outlook.Application")
    Set objNameSpace = objOutlook.GetNamespace("MAPI")
    Call objNameSpace.Logon
        
'---------------------------------------------------------------------------------
    
    Set cdb = CurrentDb                      'actual data base
    Set cdf = cdb.CreateQueryDef("")         'var. query
    cdf.SQL = "Select * from Tabl_transfert" 'SQL Statement
    Dim rec1 As Object, DbRst As String
    Set rec1 = cdf.OpenRecordset(dbReadOnly) 'rec1 are datas from data base


'----------------------------------------------------------------------------------
    
        PgCnt = 1 'Page Count
        TcmNumber = rec1.Fields(1)
        MyStr = Right(TcmNumber, 4)
        
        
        Open "C:\EXPORT MANAGEMENT\LG\HPD-" & TcmNumber & ".RCV" For Output As #1
    
        header = "=HEADER" _
                    & vbCrLf & "=ORIGIN" & vbCrLf & "=TEXT" _
                    & vbCrLf & "FFM/5/HPD-" & MyStr & "/" _
                    & UCase$(Format(Now, "ddmmm")) & "/HPD/LUX" & vbCrLf & "LUX"
                    
        
    
        Do While Not rec1.EOF
                
                data = rec1.Fields(3) & "LUX" _
                    & rec1.Fields(4) & "/T" _
                    & rec1.Fields(5) & "K" _
                    & rec1.Fields(12) & "MC0.00/COMPUTERSUPPLIES" _
                    & vbCrLf & "SCI//X"
                
                rec1.MoveNext
            
                MaxZeichenProSeite = 1600
                MaxZeichenProZeile = 69
            
                tText = header & vbCrLf & data
                
        Debug.Print Len(tText)
        
        
        Do While Len(tText) > 0
            Do While Len(tText) > 0
        
            If Len(tText) >= MaxZeichenProZeile Then
                gText = Left$(tText, MaxZeichenProZeile)
                
                    For I = MaxZeichenProZeile To 1 Step -1
                        If Mid$(gText, I, 1) = " " Then Exit For
                    Next
                
                If MZpS + I - 1 > MaxZeichenProSeite Then
                    tText = gText + tText
                    Print #1, "----- Seitenumbruch -----"
                    MZpS = 0
                    Exit Do
                End If
                
                MZpS = MZpS + I - 1
                MsgBox Len(gText)
                gText = Left$(gText, I - 1)
                tText = Right$(tText, Len(tText) - I)
                
                
            Else
                gText = tText
                tText = " "
            End If
            Print #1, gText
            
        Loop
    Loop
    Loop
        
    
    rec1.Close
    Set rec1 = Nothing
    Set cdb = Nothing
    
    If PgCnt > 1 Then
        Print #1, "CONT"
    Else
        Print #1, "LAST"
    End If
    
    Close #1
        
        
    Set objMailItem = objOutlook.CreateItem(0)
    objMailItem.To = ""
    objMailItem.CC = " "
    objMailItem.Subject = "ffm-glp Test"
    objMailItem.Body = "That's a test for the finished tasks 1 - 5 " & vbLf & " "
    objMailItem.Attachments.Add "C:\EXPORT MANAGEMENT\LG\HPD-" & TcmNumber & ".RCV"
    
    On Error GoTo f
    Call objMailItem.Display
    d = Now + 0.00002
    While Now < d
        DoEvents
    Wend

    Call objNameSpace.Logoff
    Exit Sub
f:
MsgBox Err.Description & " Oder abgebrochen!"
     
    
  
Set objMailItem = Nothing
Set objNameSpace = Nothing
Set objOutlook = Nothing
 
   
End Sub
 
ich habe dir die Schreibroutine mal so geschrieben wie ich es machen würde ich hoffe es hilft dir weiter.

Visual Basic:
Sub teileText()
    Dim text1 As String
    Dim text2 As String
    Dim maxLen As Long
    Dim maxZeile As Long
    Dim resttext As String
    Dim textToWrite As Boolean
    
    text1 = "abcdefghijkglmn"
    maxLen = 3
    maxZeile = 2
    textToWrite = Len(text1)
    
    While textToWrite
        If Len(text1) > maxLen Then
            text2 = Mid(text1, 1, maxLen)
            resttext = Mid(text1, maxLen)
        Else
            text2 = text1
            resttext = ""
        End If
        If seitenwechsel = maxZeile Then
            Debug.Print "--------Seitenwechsel-------"
            seitenwechsel = 0
        Else
            Debug.Print text2
            seitenwechsel = seitenwechsel + 1
        End If
        
        text1 = resttext
        textToWrite = Len(text1)
        
    Wend
   
    
End Sub

Grüsse bb

PS: ich würde es als seperate funktion machen dann wird es übersichtlicher
 
Es hilft mir sehr weiter, da es durchläuft ;).

Wie kann ich es realisieren das der Header nur einmal angezeigt wird und nicht bei jedem Schleifendurchlauf beim auslesen der DB. Der Header muss beim eintragen ins txt file auch mit gezählt werden (recordset + header = 1600 characters per site).

realisiert habe ich es so: Jedoch printet er mir jedesmal den Header zwischen die einzelnen Recordsets. Wie kann ich das umgehen?

Visual Basic:
'header of the document
    Header = "=HEADER" & _
               vbCrLf & "=ORIGIN" & _
               vbCrLf & "=TEXT" & _
               vbCrLf & "FFM/5/HPD/" & UCase$(Format(Now, "ddmmm")) & "/HPD/LUX" & _
               vbCrLf & "LUX"
                
    'Selecting the file from DB and writing in txt file
    
       
    Do While Not rec1.EOF
        Data = rec1.Fields(2) & _
               "LUX" & rec1.Fields(3) & _
               "/T" & rec1.Fields(4) & _
               "K" & rec1.Fields(5) & "MC0.00/COMPUTER SUPPLIES" & _
               vbCrLf & "SCI//X"
               rec1.MoveNext
    
    
        text1 = Header & vbCrLf & Data
        maxLen = 1600
        maxZeile = 69
        textToWrite = Len(text1)
    
        While textToWrite
            If Len(text1) > maxLen Then
                text2 = Mid(text1, 1, maxLen)
                resttext = Mid(text1, maxLen)
            Else
                text2 = text1
                resttext = ""
            End If
   
            If seitenwechsel = maxZeile Then
                Print #1, "--------Seitenwechsel-------"
                seitenwechsel = 0
            Else
                Print #1, text2
                seitenwechsel = seitenwechsel + 1
            End If
 
            text1 = resttext
            textToWrite = Len(text1)
        Wend
    Loop
 
1. Starte mit Seitenwechsel = 1
2. Setze nach dem ersten Header schreiben die Variable Header ="" oder
nimm folgende Anweisung einmalig vor die Schleife
Visual Basic:
 text1 = Header & vbCrLf & Data
Dabei muss Data dummerweise gefüllt sein

und in der schleife nur noch
text1 = Data
 

Neue Beiträge

Zurück