Alphanumerische Nummern in TXT Datei speichern

Hallo alle zusammen,
Ich möchte in einer TXT Datei folgendes realisieren.
Aus Excel möchte ich eine TXT Datei mit dem Namen 1_Nummern.txt auf C erstellen falls noch nicht vorhanden. In der TXT Datei soll eine Alphanumerische Zahl aufsteigend untereinander gespeichert werden. Hierzu soll aus der Tabelle2 Zelle A1 der Wert vor der eigentlichen Zahl vorangestellt werden .
Wenn die TXT Datei neu erstellt wird, dann ist in der Zeile 1 noch keine Zahl. Jetzt sollte der Zellwert aus A1 Bsp.P1_ und eine 1 hinein geschrieben werden (Format: 0000001) dies sollte nun in der Zeile 1 stehen: P1_0000001. Wenn dass Makro dass nächste mal ausgeführt wird dann steht ja bereits P1_0000001 in der Zeile 1 und jetzt soll in die nächste Zeile eine P1_0000002 geschrieben werden. Falls jetzt in der Zelle A1 z.B. P2_ steht und erneut in die TXT Datei geschrieben werden soll, dann muss P2_0000003 in der nächsten Zeile stehen usw.
Die Alphanumerischen Zahl hat immer 10 Stellen.
Das 3. Zeichen der Alphanumerischen Zahl ist immer ein Unterstrich danach kommen die Zahlen maximal 7 Zeichen lang. Wenn jetzt die Zahl nach dem Unterstrich bei 1000000 angelangt z.B. (RT_1000000) dann soll beim nächsten Durchlauf eine weitere TXT Datei mit dem Namen 2_Nummern.txt erzeugt wird wo dann wie Anfangs beschrieben derselbe Prozess abläuft wo allerdings dann bis zur nächsten 1000000 in die 2_Nummern.txt gespeichert wird.
Hier der Aufbau der TXT Datei: https://www.herber.de/bbs/user/52174.txt
Hat dafür jemand eine Lösung
Vielen Dank im Voraus!
MFG Andre

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andre,
hier mein Vorschlag. Er krankt noch etwas bei der Ermittlung der in der letzten Zeile eingetragenen Nummer.
Gruß
Franz


Sub AppendText()
Dim varDateiname As Variant
Dim intMax As Integer
Dim bolNeu As Boolean
Dim intFF As Integer
Dim lngNummer As Long
Dim strText As String
Const strDateiname As String = "_Nummern.txt" 'teil des Dateinamens
Const strVerzeichnis As String = "C:\Lokale Daten\Test" 'Verzeichnis mit den Textdateien
'Prüfen ob Dateien schon vorhanden
varDateiname = Dir(Pathname:=strVerzeichnis & Application.PathSeparator _
& "*" & strDateiname)
If varDateiname = "" Then
varDateiname = strVerzeichnis & Application.PathSeparator & "1" & strDateiname
bolNeu = True
Else
'Letzte Nummerndatei ermitteln
intMax = 1
Do Until varDateiname = ""
If CInt(Left(varDateiname, InStr(1, varDateiname, "_") - 1)) > intMax Then
intMax = CInt(Left(varDateiname, InStr(1, varDateiname, "_") - 1))
End If
varDateiname = Dir
Loop
varDateiname = strVerzeichnis & Application.PathSeparator & intMax _
& strDateiname
End If
intFF = FreeFile()
If bolNeu = True Then
lngNummer = 1
Else
'Nummer in der letzten eingetragenen Zeile ermitteln.
'Hier muss der Zugriff auf den letzten Datensatz der textdatei optimiert _
werden, da bei vielen Datenzeilen die Laufzeit unerträglich wird. _
Wahrscheinlich irgendetwas mit Connections und Recordset.
Open varDateiname For Input Access Read As #intFF
Do Until EOF(intFF)
'Input #intFF, strText
Line Input #intFF, strText
Loop
Close #intFF
lngNummer = CLng(Mid(strText, 4)) + 1
If lngNummer > 1000000 Then
varDateiname = strVerzeichnis & Application.PathSeparator & intMax + 1 _
& strDateiname
lngNummer = 1
End If
End If
Open varDateiname For Append As #intFF
strText = Worksheets(2).Range("A1") & Format(lngNummer, "0000000")
'Write #intFF, strText
Print #intFF, strText
Close #intFF
End Sub

Sub LetztenWertHolen() Dim varDateiname As Variant Dim intMax As Integer Dim intFF As Integer Dim strText As String Dim lngNummer As Long Const strDateiname As String = "_Nummern.txt" 'teil des Dateinamens Const strVerzeichnis As String = "C:\Lokale Daten\Test" 'Verzeichnis mit den Textdateien 'Prüfen ob Dateien schon vorhanden varDateiname = Dir(Pathname:=strVerzeichnis & Application.PathSeparator _ & "*" & strDateiname) If varDateiname = "" Then MsgBox "Es gibt noch keine Datei " & strVerzeichnis & Application.PathSeparator _ & "1" & strDateiname Else 'Letzte Nummerndatei ermitteln intMax = 1 Do Until varDateiname = "" If CInt(Left(varDateiname, InStr(1, varDateiname, "_") - 1)) > intMax Then intMax = CInt(Left(varDateiname, InStr(1, varDateiname, "_") - 1)) End If varDateiname = Dir Loop varDateiname = strVerzeichnis & Application.PathSeparator & intMax _ & strDateiname intFF = FreeFile() 'Nummer in der letzten eingetragenen Zeile ermitteln. Open varDateiname For Input Access Read As #intFF Do Until EOF(intFF) Line Input #intFF, strText Loop Close #intFF lngNummer = CLng(Mid(strText, 4)) 'Wert in Spalte 7 (G) der aktiven Zeile schreiben Cells(ActiveCell.Row, 7).Value = lngNummer End If End Sub

Beliebteste Forumthreads (12 Monate)

Alphanumerische Nummern in TXT Datei speichern

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread