Microsoft Excel

Herbers Excel/VBA-Archiv

Textdatei aus Excel für Datenimport | Herbers Excel-Forum


Betrifft: Textdatei aus Excel für Datenimport von: Ronald
Geschrieben am: 28.01.2010 17:08:55

Hallo,

ich brauche eine Textdatei die ich in einem anderen Programm einlesen will. In der Textdatei muss unbedingt die Schnittstellenbeschreibung eingehalten werden.

A1 = 01
B1 = 0000005401
C1 = AOK Krankenkasse M-V
D1 = Meier

In der Textdatei muss dann am Ende die Sache so aussehen:

010000005401AOK Krankenkasse ___________________________________________M-V Meier

die _ Zeichen sollen Leerzeichen sein.

dann der nächste Datensatz.

in C1 der Text ist immer kürzer als 60 Zeichen, muss dann auf 60 Zeichen mit Leerezeichen aufgefüllt werden.

Wie bekommt man sowas hin?

Gruß Ronald

  

Betrifft: kannst mal diesen Code testen. von: Tino
Geschrieben am: 28.01.2010 18:00:11

Hallo,

die Textdatei wird im gleichen Ordner wo sich auch die Excel- Datei befindet abgelegt.
Ist diese vorhanden wird sie zuvor gelöscht.

Tabellennamen noch anpassen.

Sub schreibeTXTDatei()
Dim F As Integer
Dim sFilePath$, FileName$, strAusgabe$
Dim strSpalte3 As String * 60
Dim meAr
Dim A&, AA&

'Dateiname der Textdatei (Ausgabe) 
FileName = "TextDatei.txt"

'Tabelle anpassen 
meAr = Sheets("Tabelle1").UsedRange.Columns("A:D").Value

'wird im Ordner der Exceldatei gespeichert 
sFilePath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
FileName = sFilePath & FileName

'alte Datei löschen fals vorhanden. 
If Dir(FileName) <> "" Then Kill FileName
  
  F = FreeFile
  Open FileName For Append As #F
  
  For A = 1 To Ubound(meAr)
    For AA = 1 To Ubound(meAr, 2)
        If AA = 3 Then
         strSpalte3 = meAr(A, AA)
         strAusgabe = strAusgabe & strSpalte3
        ElseIf AA > 3 Then
         strAusgabe = strAusgabe & " " & meAr(A, AA)
        Else
         strAusgabe = strAusgabe & meAr(A, AA)
        End If
    Next AA
    
    Print #F, strAusgabe
    strAusgabe = ""
  Next A
  
  Close #F

End Sub
Gruß Tino


  

Betrifft: Korrektur ... von: Tino
Geschrieben am: 28.01.2010 18:37:18

Hallo,
habe jetzt erst gesehen das die Leerzeichen wo anders stehen sollen.


Sub schreibeTXTDatei()
Dim F As Integer
Dim sFilePath$, FileName$, strAusgabe$
Dim tmpStr$
Dim meAr
Dim A&, AA&

'Dateiname der Textdatei (Ausgabe) 
FileName = "TextDatei.txt"

'Tabelle anpassen 
meAr = Sheets("Tabelle1").UsedRange.Columns("A:D").Value

'wird im Ordner der Exceldatei gespeichert 
sFilePath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
FileName = sFilePath & FileName

'alte Datei löschen fals vorhanden. 
If Dir(FileName) <> "" Then Kill FileName
  
  F = FreeFile
  Open FileName For Append As #F
  
  For A = 1 To Ubound(meAr)
    For AA = 1 To Ubound(meAr, 2)
        If AA = 3 Then
         tmpStr = Left$(meAr(A, AA), InStrRev(meAr(A, AA), " ") - 1)
         tmpStr = tmpStr & String(61 - Len(meAr(A, AA)), " ") & _
                  Right$(meAr(A, AA), Len(meAr(A, AA)) - InStrRev(meAr(A, AA), " "))
         strAusgabe = strAusgabe & tmpStr
        ElseIf AA > 3 Then
         strAusgabe = strAusgabe & " " & meAr(A, AA)
        Else
         strAusgabe = strAusgabe & meAr(A, AA)
        End If
    Next AA
    
    Print #F, strAusgabe
    strAusgabe = ""
  Next A
  
  Close #F

End Sub
Gruß Tino


  

Betrifft: AW: Korrektur ... von: Ronald
Geschrieben am: 29.01.2010 09:52:43

Hallo Tino,

vielen Dank erstmal. Leider bekomme ich eine Fehlermeldung. Ich hänge die Datei mal dran.

https://www.herber.de/bbs/user/67609.xls


Gruß Ronald


  

Betrifft: ok. nochmal, von: Tino
Geschrieben am: 29.01.2010 11:37:27

Hallo,
irgendwie kommt es mir vor dass die Datei anders aussieht wie im ersten Beitrag beschrieben.

Sub schreibeTXTDatei()
Dim F As Integer
Dim sFilePath$, FileName$, strAusgabe$
Dim tmpStr$, strText$
Dim rngBereich As Range, rngRows As Range
Dim A&, AA&


'Dateiname der Textdatei (Ausgabe) 
FileName = "TextDatei.txt"

'Tabelle anpassen 
Set rngBereich = Sheets("Tabelle1").UsedRange.Columns("A:D")

'wird im Ordner der Exceldatei gespeichert 
sFilePath = IIf(Right$(ThisWorkbook.Path, 1) = "\", ThisWorkbook.Path, ThisWorkbook.Path & "\")
FileName = sFilePath & FileName

'alte Datei löschen fals vorhanden. 
If Dir(FileName) <> "" Then Kill FileName
With Application.WorksheetFunction
  F = FreeFile
  Open FileName For Append As #F
  
  For Each rngBereich In rngBereich.Rows
    For Each rngRows In rngBereich.Cells
       
        If rngRows.Column = 3 Then
         If InStr(rngRows.Text, " ") > 0 Then
            strText = Trim$(.Clean(rngRows.Text))
            tmpStr = Left$(strText, InStrRev(strText, " ") - 1)
            tmpStr = tmpStr & String(61 - Len(strText), " ") & _
                     Right$(strText, Len(strText) - InStrRev(strText, " "))
            strAusgabe = strAusgabe & tmpStr
         Else
            strAusgabe = strAusgabe & String(60, " ")
         End If
        ElseIf rngRows.Column > 3 Then
         strAusgabe = strAusgabe & " " & .Clean(rngRows.Text)
        Else
         strAusgabe = strAusgabe & .Clean(rngRows.Text)
        End If
    Next rngRows
    
    Print #F, strAusgabe
    strAusgabe = ""
  Next rngBereich
  
  Close #F
End With
End Sub
Gruß Tino


  

Betrifft: AW: ok. nochmal, von: Ronald
Geschrieben am: 29.01.2010 12:10:41

Hallo Tino,

ja, das sieht fantastisch aus und die Datei war bestimmt vorher anders, hab schon soviel probiert. Die paar Spalten sind ja auch nur ein Auszug der ganzen Daten. Es komplett noch viel mehr Spalten. Ich bin schon seit heute morgen dabei die Daten in einer Exceldatei mit Formeln zusammenzutragen.

Kann man Dein Makro dann noch anpassen? Ich habe am Ende Spalten von A bis BD, wobei ich in jeder Excel Zelle jetzt die genaue Zeichenanzahl habe. In Spalte A steht jetzt z.B. 01 in der Textdatei schreibt er jetzt 1. Ich weiß nicht ob das sehr aufwendig ist.

Vielen Dank für Deine Hilfe.

Gruß Ronald


  

Betrifft: ok. habe nochmal komplett neu angefangen. von: Tino
Geschrieben am: 29.01.2010 13:08:19

Hallo,
hier das Beispiel als zip.
Die Exceldatei sollte wie im Beispiel aufgebaut sein.

https://www.herber.de/bbs/user/67622.zip

In der Excel auf den Button drücken.

Mehr kann ich nicht machen.

Gruß Tino


  

Betrifft: AW: ok. habe nochmal komplett neu angefangen. von: Ronald
Geschrieben am: 29.01.2010 14:44:57

Vielen Dank Tino,

löst mein Problem zwar nicht vollständig, aber danke für Deine Mühe.

Ich hab die Exceldatei jetzt fertig und versuche mein Glück hier im Forum nochmal.

Gruß Ronald


  

Betrifft: warum neuer Beitrag? von: Tino
Geschrieben am: 28.01.2010 18:48:52

Hallo,

https://www.herber.de/forum/archiv/1132to1136/t1133804.htm

Hättest auch dort bleiben können, warum neuer Beitrag?


Gruß Tino


Beiträge aus den Excel-Beispielen zum Thema "Textdatei aus Excel für Datenimport"