AW: .txt's mit VBA bearbeiten
01.07.2012 23:01:00
Horst
Hallo Sepp,
besten Dank für deine Bemühungen! Das Makro bearbeitet die Dateien "train.txt", "retrain.txt" und "test.txt", scheint hier einiges zu löschen, die eigentlich zu bearbeitende "instrum.txt" bleibt allerdings unverändert. Woran könnte es liegen?
Gruß, Horst
Sub changeTXT_File2()
Dim strFile As String, strTrainFile As String, strReTrainFile As String, strTestFile As _
String
Dim strTmpFile As String, strTmp As String
Dim lngIndex As Long, lngCol As Long, lngC As Long
Dim vntTmp As Variant, strTrain() As String, strReTrain() As String, strTest() As String
Dim FF1 As Integer, FF2 As Integer
strTrainFile = "C:\Programme\Signal_Pro\update\train_one.txt" 'Dateipfad train.txt - Anpassen
strReTrainFile = "C:\Programme\Signal_Pro\update\retrain_one.txt" 'Dateipfad retrain.txt - _
Anpassen
strTestFile = "C:\Programme\Signal_Pro\update\test_one.txt" 'Dateipfad test.txt - Anpassen
strFile = "C:\Programme\Signal_Pro\update\instrum.txt" 'Dateipfad Eingabe-Datei - Anpassen!
strTmpFile = Environ("TEMP") & "\Temp.txt"
'## train.txt einlesen
FF1 = FreeFile
Open strTrainFile For Input As #FF1
Do While Not EOF(FF1)
Line Input #FF1, strTmp
vntTmp = Split(strTmp, vbTab)
ReDim Preserve strTrain(lngIndex)
strTrain(lngIndex) = Trim$(Application.Clean(vntTmp(123)))
Loop
Close #FF1
'## retrain.txt einlesen
FF1 = FreeFile
lngIndex = 0
Open strReTrainFile For Input As #FF1
lngIndex = 0
Do While Not EOF(FF1)
Line Input #FF1, strTmp
vntTmp = Split(strTmp, vbTab)
ReDim Preserve strReTrain(lngIndex)
strReTrain(lngIndex) = Trim$(Application.Clean(vntTmp(123)))
Loop
Close #FF1
'## test.txt einlesen
FF1 = FreeFile
lngIndex = 0
Open strTestFile For Input As #FF1
Do While Not EOF(FF1)
Line Input #FF1, strTmp
vntTmp = Split(strTmp, vbTab)
ReDim Preserve strTest(lngIndex)
strTest(lngIndex) = Trim$(Application.Clean(vntTmp(123)))
Loop
Close #FF1
'## train.txt erstellen
FF1 = FreeFile
lngIndex = 0
Open strFile For Input As #FF1
FF2 = FreeFile
Open strTmpFile For Output As #FF2
Do While Not EOF(FF1) And lngC 5 Then
vntTmp = Split(strTmp, vbTab)
strTmp = ""
If UBound(vntTmp) > 1 Then
For lngCol = 2 To UBound(vntTmp)
strTmp = strTmp & Trim$(Application.Clean(vntTmp(lngCol))) & vbTab
Next
End If
strTmp = strTmp & strTrain(lngC)
lngC = lngC + 1
Print #FF2, strTmp
End If
Loop
Close #FF2
Close #FF1
Kill strTrainFile
Name strTmpFile As strTrainFile
'## retrain.txt erstellen
FF1 = FreeFile
lngIndex = 0
lngC = 0
Open strFile For Input As #FF1
FF2 = FreeFile
Open strTmpFile For Output As #FF2
Do While Not EOF(FF1) And lngC 5 + UBound(strTrain) + 1 Then
vntTmp = Split(strTmp, vbTab)
strTmp = ""
If UBound(vntTmp) > 1 Then
For lngCol = 2 To UBound(vntTmp)
strTmp = strTmp & Trim$(Application.Clean(vntTmp(lngCol))) & vbTab
Next
End If
strTmp = strTmp & strReTrain(lngC)
lngC = lngC + 1
Print #FF2, strTmp
End If
Loop
Close #FF2
Close #FF1
Kill strReTrainFile
Name strTmpFile As strReTrainFile
'## test.txt erstellen
FF1 = FreeFile
lngIndex = 0
lngC = 0
Open strFile For Input As #FF1
FF2 = FreeFile
Open strTmpFile For Output As #FF2
Do While Not EOF(FF1) And lngC 5 + UBound(strTrain) + UBound(strReTrain) + 2 Then
vntTmp = Split(strTmp, vbTab)
strTmp = ""
If UBound(vntTmp) > 1 Then
For lngCol = 2 To UBound(vntTmp)
strTmp = strTmp & Trim$(Application.Clean(vntTmp(lngCol))) & vbTab
Next
End If
strTmp = strTmp & strTest(lngC)
lngC = lngC + 1
Print #FF2, strTmp
End If
Loop
Close #FF2
Close #FF1
Kill strTestFile
Name strTmpFile As strTestFile
End Sub