Daten auslesen

Hallo zusammen,
ich brauche mal wieder Eure Hilfe. Ich möchte mit einem Daten aus einer txt. datei in eine Excel Liste transponieren. Von einem Ex-Mitarbeiter habe ich ein makro vorliegen.
Das Macro öffnet die txt. Datei schreibt die daten in eine neue exceldatei und speichert diese automatisch ab.
Mein skript sieht zum auslesen sieht bisher so aus: (Auszug)
Dim Dateiname
Dim Persnr As String
Dim Durchwahl As String
Dim Ort As String
Dim Raum As String
Dim Bereich String
Dim Kostenstelle String
Dim Verein String
Dim Anzahl
Dim c
Dateiname = ActiveWorkbook.Name
Anzahl = 0
Tabs = Chr(9)
On Error GoTo Fehler:
Open "c:\daten\Mitarbeiter.txt" For Input As #1
On Error GoTo 0
Open "C:\Daten\Mitarbeiterdaten.txt" For Output As #2
Persnr = ""
Durchwahl = ""
Ort = ""
Raum = ""
Bereich = ""
Kostenstelle = ""
Verein = ""
Application.StatusBar = "Bitte etwas Geduld."
Application.ScreenUpdating = False
Print #2, "Persnum" + Tabs + "Durchwahl" + Tabs + "Ort" + Tabs + "Raum" + Tabs + _
"Bereich" + Tabs + "Kostenstelle" + Tabs + "Verein"
While Not EOF(1)
Line Input #1, Satz
If Left(Satz, 1) = Chr(12) Then
Print #2,Persnum + Tabs + Durchwahl + Tabs + Ort + Tabs + Raum + Tabs + _
Bereich + Tabs + Kostenstelle + Tabs + Verein
Persnr = ""
Durchwahl = ""
Ort = ""
Raum = ""
Bereich = ""
Kostenstelle = ""
Verein = ""
Anzahl = Anzahl + 1
If Anzahl Mod 100 = 0 Then Application.StatusBar = "Bitte etwas Geduld. " & Anzahl & " Sätze erstellt."
End If
If Left(Satz, 9) = Persnr = "" Then Persnum = Mid(Satz, 12)
If Left(Satz, 5) = Durchwahl = "" Then Durchwahl = Mid(Satz, 8)
If Left(Satz, 8) = "Ort:" Then Ort = Mid(Satz, 11)
If Left(Satz, 12) = "Raum:" Then Raum = Mid(Satz, 15)
If Left(Satz, 16) = "Bereich:" Then Bereich = Mid(Satz, 19)
If Left(Satz, 3) = "Kostenstelle:" Then Kostenstelle = Mid(Satz, 6)
If Left(Satz, 11) = "Verein" Then Verein= Mid(Satz, 14)
Close #1
Close #2
Application.StatusBar = ""
Workbooks.OpenText Filename:="C:\Daten\Mitarbeiterdaten.txt", _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
............
.........
Ich hab folgendes Beispiel mal hochgeladen
https://www.herber.de/bbs/user/56257.doc
https://www.herber.de/bbs/user/56256.xls
Vielen Dank für Eure Hilfe
Beste Grüsse
Rainer

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten auslesen

26.10.2008 05:45:00

Tino

AW: Daten auslesen

26.10.2008 06:56:00

Rainer

AW: Daten auslesen

26.10.2008 06:58:00

Tino

Option Explicit Sub LeseTextFile() Dim strDatei As String Dim sString() As String, sTemp1() As String, sTemp Dim i As Long, j As Long, A As Long '***************************************************** strDatei = "C:\Textdatei.txt" 'Pfad zur Datei anpassen j = 2 'erste Einfügezeile 'alte Daten löschen Range("A1", Cells(Rows.Count, Columns.Count)).ClearContents 'String aus Textfile holen sString = Split(txt_ReadAll(strDatei), vbCr) With Application.WorksheetFunction 'String zerlegen und in Zellen schreiben For i = Lbound(sString) To Ubound(sString) sTemp1 = Split(sString(i), vbTab) For A = 1 To Ubound(sTemp1) If .Clean(sTemp1(A - 1)) = "Personalnummer" And sTemp <> "" Then Range(Cells(j, "A"), Cells(j, "I")) = Split(sTemp, ">") j = j + 1: sTemp = "" End If sTemp = sTemp & sTemp1(A) & ">" Next A Next i End With End Sub Public Function txt_ReadAll(ByVal sFilename As String) As String Dim F As Integer Dim sInhalt As String If Dir$(sFilename, vbNormal) <> "" Then F = FreeFile Open sFilename For Binary As #F sInhalt = Space$(LOF(F)) Get #F, , sInhalt Close #F End If txt_ReadAll = sInhalt End Function

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread