wie kann ich bitte per VBA in einem Pfad D:\Daten\Projkete\Settings\ inklusive Unterverzeichnissen in allen Dateien mit der Dateiendung .cmd die Zeilen löschen in den als Wort / String dies "BA-SAR04" vorkommt?
Beste Grüße,
Sergej
Code:
[Cc][+][-]
Option Explicit
Const sSuch As String = "BA-SAR04"
'Const sPath = "D:\Daten\Projekte\Settings\"
Const sPath As String = "C:\ControlApp\"
Sub CheckFileStart()
'Durchforsten von gefilterten Dateien aus Ordner und Unterordner
Dim iAnz As Long, sArr() As String, MsgTxt As String
CheckFile iAnz, sArr, CreateObject("scripting.filesystemobject").GetFolder(sPath)
If iAnz = 0 Then
MsgTxt = "Es wurde keine entsprechende Datei gefunden!"
Else
MsgTxt = "Es wurde(n) " & iAnz & " Datei(en) gefunden und bearbeitet!"
End If
MsgBox MsgTxt, vbInformation, "Dateibearbeitung"
End Sub
Sub CheckFile(iAnz As Long, sArr, oPath As Object)
Dim oFile As Object, oDir As Object, Obj As Variant
Dim sFilename As String, sData As String, sArrZL() As String
Dim iff As Integer, i As Long
On Error Resume Next
For Each oFile In oPath.Files 'Ordner durchsuchen
If err = 0 Then
With oFile
err = 0
If .Name Like "*.cmd" Then 'Datei ausfiltern
iff = FreeFile()
Open .Path For Input As iff 'Datei öffnen
sData = Input(LOF(iff), #iff) 'und Daten einlesen
Close iff 'Datei schließen
If InStr(sData, sSuch) > 0 Then
'Datei enthält das Suchwort, jetzt die Zeile rausnehmen
Open .Path For Output As iff
sArrZL = Split(sData, vbCrLf) 'Daten aufsplitten
For i = 0 To UBound(sArrZL)
If InStr(sArrZL(i), sSuch) = 0 Then
Print #iff, sArrZL(i)
End If
Next i
Close iff 'Datei schließen
iAnz = iAnz + 1
End If
End If
End With
End If
Next
For Each oDir In oPath.Subfolders 'Unterordner durchsuchen
Obj = FileDateTime(oDir)
CheckFile iAnz, sArr, oDir
Next
End Sub
Code:
[Cc][+][-]
Option Explicit
Const sSuch As String = "CH-ETT01"
Const sErsetz As String = "DE-WUP08"
Const sPath As String = "D:\Daten\Projekte\Settings\"
Sub CheckFileStart()
'Durchforsten von gefilterten Dateien aus Ordner und Unterordner
Dim iAnz As Long, sArr() As String, MsgTxt As String
CheckFile iAnz, sArr, CreateObject("scripting.filesystemobject").GetFolder(sPath)
If iAnz = 0 Then
MsgTxt = "Es wurde keine entsprechende Datei gefunden!"
Else
MsgTxt = "Es wurde(n) " & iAnz & " Datei(en) gefunden und bearbeitet!"
End If
MsgBox MsgTxt, vbInformation, "Dateibearbeitung"
End Sub
Sub CheckFile(iAnz As Long, sArr, oPath As Object)
Dim oFile As Object, oDir As Object, Obj As Variant
Dim sFilename As String, sData As String, sArrZL() As String
Dim iff As Integer, i As Long, sErweiterung As String
On Error Resume Next
For Each oFile In oPath.Files 'Ordner durchsuchen
If err = 0 Then
With oFile
err = 0
If .Name Like "*.cmd" Then 'Datei ausfiltern
sErweiterung = ""
iff = FreeFile()
Open .Path For Input As iff 'Datei öffnen
sData = Input(LOF(iff), #iff) 'und Daten einlesen
Close iff 'Datei schließen
If InStr(sData, sSuch) > 0 Then
'Datei enthält das Suchwort, jetzt die Zeile rausnehmen
Open .Path For Output As iff
sArrZL = Split(sData, vbCrLf) 'Daten aufsplitten
For i = 0 To UBound(sArrZL)
If InStr(sArrZL(i), sSuch) > 0 Then
sErweiterung = sErweiterung _
& Replace(sArrZL(i), sSuch, sErsetz) & vbCrLf
End If
Print #iff, sArrZL(i) 'Daten in Datei schreiben
Next i
If sErweiterung <> "" Then
sErweiterung = Left$(sErweiterung, Len(sErweiterung) - 1)
Print #iff, sErweiterung 'Kopierte Texte unten dran
End If
Close iff 'Datei schließen
iAnz = iAnz + 1
End If
End If
End With
End If
Next
For Each oDir In oPath.Subfolders 'Unterordner durchsuchen
Obj = FileDateTime(oDir)
CheckFile iAnz, sArr, oDir
Next
End Sub
Code:
[Cc][+][-]
Option Explicit
Const sSuch As String = "CH-ETT01"
Const sErsetz As String = "DE-WUP08"
Const sPath As String = "D:\Daten\Projekte\Settings\"
Sub CheckFileStart()
'Durchforsten von gefilterten Dateien aus Ordner und Unterordner
Dim iAnz As Long, sArr() As String, MsgTxt As String
CheckFile iAnz, sArr, CreateObject("scripting.filesystemobject").GetFolder(sPath)
If iAnz = 0 Then
MsgTxt = "Es wurde keine entsprechende Datei gefunden!"
Else
MsgTxt = "Es wurde(n) " & iAnz & " Datei(en) gefunden und bearbeitet!"
End If
MsgBox MsgTxt, vbInformation, "Dateibearbeitung"
End Sub
Sub CheckFile(iAnz As Long, sArr, oPath As Object)
Dim oFile As Object, oDir As Object, Obj As Variant
Dim sFilename As String, sData As String, sArrZL() As String
Dim iff As Integer, i As Long
On Error Resume Next
For Each oFile In oPath.Files 'Ordner durchsuchen
If err = 0 Then
With oFile
err = 0
If .Name Like "*.cmd" Then 'Datei ausfiltern
iff = FreeFile()
Open .Path For Input As iff 'Datei öffnen
sData = Input(LOF(iff), #iff) 'und Daten einlesen
Close iff 'Datei schließen
If InStr(sData, sSuch) > 0 Then
'Datei enthält das Suchwort, jetzt die Zeile rausnehmen
Open .Path For Output As iff
sArrZL = Split(sData, vbCrLf) 'Daten aufsplitten
For i = 0 To UBound(sArrZL)
Print #iff, sArrZL(i) 'Daten in Datei schreiben
If InStr(sArrZL(i), sSuch) > 0 Then
Print #iff, Replace(sArrZL(i), sSuch, sErsetz)
End If
Next i
Close iff 'Datei schließen
iAnz = iAnz + 1
End If
End If
End With
End If
Next
For Each oDir In oPath.Subfolders 'Unterordner durchsuchen
Obj = FileDateTime(oDir)
CheckFile iAnz, sArr, oDir
Next
End Sub