AW: Textdatei öffnen bearbeiten und schließen
01.06.2017 05:02:30
fcs
Hallo Furkan,
ich hab hier jetzt keine VB-Version.
Unter VBA für Excel muss das Makro wie folgt aussehen.
In deinem Makro ist ein grundsätzliche Problem:
Du kannst nicht die gleiche Datei für Input und Output öffnen.
Weiter ist die Frage: Was ist teil(0)?
Wird diese Variable in einem anderen Makro gefüllt und ist im Modul als Private oder Public deklariert?
Die Anzahl der Zeichn in einem Text musst du auch anders ermitteln.
Die Funktion InStr ermittelt die Position eines Textes in einem anderen Text.
Evtl. findest du ja die passenden Anweisungen, um das Makro von VBA auf VB umzuschreiben.
Gruß
Franz
'VBA-Code erstellt unter Excel 2010
Option Explicit
Public teil(0 To 3) As String
'Private Sub Adden()
Sub Adden()
Dim zeile As String
Dim FF1 As Integer, FF2 As Integer
Dim pos As Integer, AnzPunkte As Integer
Dim strFind As String, strReplace As String
Dim strFile1 As String, strFile2 As String
On Error GoTo Fehler
teil(0) = "##Einfüge-Text##" 'Testzeile
strFile1 = "C:\Users\Furkan\Desktop\data.txt" 'Name Original-Textdatei
strFile2 = "C:\Users\Furkan\Desktop\tempdatatemp.txt" 'Name temporäre Textdatei
strFile1 = "C:\Users\Admin\Desktop\data.txt" 'Name Original-Textdatei
strFile2 = "C:\Users\Admin\Desktop\tempdatatemp.txt" 'Name temporäre Textdatei
FF1 = FreeFile()
Open strFile1 For Input As #FF1
FF2 = FreeFile()
Open strFile2 For Output As #FF2
strFind = Chr(10)
strReplace = vbCrLf
Do While Not EOF(FF1)
'Zeile einlesen
Line Input #FF1, zeile
'Position von "." suchen
pos = InStr(1, zeile, ".")
AnzPunkte = 0
If pos > 0 Then
'Anzahl Punkte in Zeilen-Text berechnen
AnzPunkte = Len(zeile) - Len(Replace(zeile, ".", ""))
End If
If Len(zeile) > 0 Then
'Anzahl Punkte prüfen und ggf. Text modifizierten
Select Case AnzPunkte
Case 0
'Text nicht modifizieren
Case 3
zeile = VBA.Replace(zeile, strFind, strReplace, compare:=vbBinaryCompare)
zeile = zeile & teil(0) ' was ist teil(0)
Case Else
zeile = zeile & " " & teil(0)
End Select
End If
Print #FF2, zeile
Loop
Close FF1
Close FF2
'Original-Datei löschen
VBA.Kill strFile1
'temporäre Datei umbenennen in Name der Originaldatei
Name strFile2 As strFile1
'ggf. temporäre Datei wieder löschen
If Dir(strFile2) "" Then VBA.Kill strFile2
Fehler:
With Err
Select Case .Number
Case 0
Case Else
MsgBox "Fehler-nr.: " & .Number & vbLf & .Description
Close
End Select
End With
End Sub