Open for Input - Limit für Textzeilen?
10.01.2007 13:27:01
MartinCH
In einem Makro öffne ich ein *.xml File damit ich Zeilenweise den String prüfen und gegebenfalls ersetzen kann.
Nun funktioniert das eigentlich reibungslos, bis auf die Tatsache, dass einige Zeilen ohne logischen Grund übersprungen werden.
Ist es möglich, dass es ein Limit für Textzeilen gibt ider gibt es die Möglichkeit bei "Input #1, Text" explizit eine bestimmte Textzeile zu definieren?
Oder kann ich das Ursprungsfile eventuell in zwei Teile Spitten anschliessend Umwandeln und danach wieder zusammenführen?
Es handelt sich beim original File übrigens um 411027 Textzeilen bei einer Dateigrösse von 13.5 MB.
Besten Dank für Eure Infos.
Hier für Interessierte der Script.
Sub SubstituteSave()
Dim arr() As String
Dim iCounter As Double
Dim sSource As String, sTarget As String, sTxtA As String
Dim sTxtB As String, sTxt As String, sPath As String
Dim strMatch1 As String, strMatch2 As String
Dim strMatch3 As String, strMatch4 As String
Dim strMatch5 As String, strMatch6 As String
Dim strMatch7 As String, strMatch8 As String
Dim intFront As Integer, intEnd As Integer
Dim Param1 As Integer
Dim Param2 As Integer
Dim Param3 As Integer
Dim Param3_1 As String
Dim PrüferMatch1 As Boolean
Dim TxtLines As Double
Dim Text1 As String
Dim i As Double
sPath = Range("B7").Value & "\" 'Pfad der Datei
sSource = sPath & Range("B1").Value ' Name der Textdatei
sTarget = sPath & Range("B4").Value ' Neuer Name der Textdatei
sTxtA = Range("B2").Value ' alter Text
sTxtB = Range("B3").Value ' neuer Text
strMatch1 = Range("D2").Value 'vordere Begrenzung1
strMatch2 = Range("D3").Value 'hintere Begrenzung1
strMatch3 = Range("D4").Value 'vordere Begrenzung2
strMatch4 = Range("D5").Value 'hintere Begrenzung2
strMatch5 = Range("D6").Value 'vordere Begrenzung3
strMatch6 = Range("D7").Value 'hintere Begrenzung3
strMatch7 = Range("F2").Value 'vordere Begrenzung4
strMatch8 = Range("F3").Value 'hintere Begrenzung4
PrüferMatch1 = False
Close
Open sSource For Input As #1
Do While Not EOF(1) ' Schleife bis Dateiende.
Input #1, Text1 ' Hilfsvariable zum einlesen verwenden
'Zähler hochzählen
TxtLines = TxtLines + 1
Loop
'Schliessen der Datei weil Dateiende erreicht wurde
Close #1
Open sSource For Input As #1
'Do Until EOF(1)
For i = 1 To TxtLines
'Eine Zeile mit der Zeilennummer einlesen
Line Input #1, sTxt
'Zeilentext mit Vorgabe1 prüfen
If InStr(1, sTxt, strMatch1) > 0 Then
Param1 = Channel_Path(Mid(sTxt, Len(strMatch1) + 1, (Len(sTxt) - (Len(strMatch1) + Len(strMatch2)))))
PrüferMatch1 = True
End If
'Zeilentext mit Vorgabe2 prüfen
If InStr(1, sTxt, strMatch3) > 0 Then
Param2 = Location_Path(Mid(sTxt, Len(strMatch3) + 1, (Len(sTxt) - (Len(strMatch3) + Len(strMatch4)))))
PrüferMatch1 = True
End If
'Zeilentext mit Vorgabe3 prüfen
If InStr(1, sTxt, strMatch5) > 0 Then
Param3 = Product_Path(Mid(sTxt, Len(strMatch5) + 1, (Len(sTxt) - (Len(strMatch5) + Len(strMatch6)))))
Param3_1 = Kuerzen_Product(Mid(sTxt, Len(strMatch5) + 1, (Len(sTxt) - (Len(strMatch5) + Len(strMatch6)))))
PrüferMatch1 = True
End If
'Zeilentext mit Vorgabe4 prüfen und PrüferMatch1 = True
'Application.Wait Now + TimeSerial(0, 0, 0.1)
If InStr(1, sTxt, strMatch7) > 0 Then
If PrüferMatch1 = True Then
sTxtB = strMatch7 & Set_the_String(Param1, Param2, Param3, Param3_1) & strMatch8
sTxt = sTxtB
sTxtB = ""
PrüferMatch1 = False
Param1 = 0
Param2 = 0
Param3 = 0
Param3_1 = ""
Else
sTxtB = strMatch7 & "Default" & strMatch8
sTxt = sTxtB
PrüferMatch1 = False
Param1 = 0
Param2 = 0
Param3 = 0
Param3_1 = ""
sTxtB = ""
End If
End If
iCounter = iCounter + 1
ReDim Preserve arr(1 To iCounter)
arr(iCounter) = sTxt
Next i
Close
Open sTarget For Output As #1
For iCounter = 1 To UBound(arr)
Print #1, arr(iCounter)
Next iCounter
Close
On Error GoTo ERRORHANDLER
Shell "notepad " & sTarget, vbMaximizedFocus
MsgBox " Job erledigt!"
ERRORHANDLER:
End Sub