Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1224to1228
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

mit VBA/VBS Textdateien bearbeiten ?

mit VBA/VBS Textdateien bearbeiten ?
Mandy
Hallo,
habe mal ne andere Frage:
Ich habe im Moment ein Schlag voll Textdateien (ein paar Hundert). Alle Textdateien sind gleich Strukturiert.
Es gibt ein Vorspann,
ein Inhalt und
ein Nachspann
Ich müsste nun jedes File aufmachen, alles bis auf den INHALT Löschen und wieder schliessen. :-(((
Blödes GEschäft.
Da kam mir die Idee, ob das nicht viellecht mit VBA geht.
Kann man mit VBA auf ein Verzeichnis zugreifen, dort nacheinander, einzeln eine Textdatei aufmachen, alles Löschen, was bis "HIER IST DER VORSPANN ZU ENDE" geht und alles löschen, was nach "HIER BIGINNT DER NACHSPANN" kommt, dann Datei wieder zu ?
Falls ja, und jemand hatt ein Beispiel, würde ich mich sehr freuen.
Danke
Mandy

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: mit VBA/VBS Textdateien bearbeiten ?
19.08.2011 14:37:23
ransi
HAllo Mandy
Versuchs mal mit diesem kleinen Code:
Option Explicit

Const Verzeichnis = "C:\Users\Quarantaene" 'Anpassen
Const strStart As String = "HIER IST DER VORSPANN ZU ENDE"
Const strEnde As String = "HIER BIGINNT DER NACHSPANN"

Public Sub machs()
    Dim FSO As Object
    Dim DAtei, txtDatei As Object, strTmp As String
    Dim arr As Variant
    Set FSO = CreateObject("Scripting.FilesystemObject")
    
    For Each DAtei In FSO.getfolder(Verzeichnis).Files
        If LCase(FSO.getextensionname(DAtei)) = "txt" Then
            Set txtDatei = FSO.opentextfile(DAtei)
            strTmp = txtDatei.readall
            txtDatei.Close
            strTmp = Replace(strTmp, strStart, "#####")
            strTmp = Replace(strTmp, strEnde, "#####")
            arr = Split(strTmp, "#####")
            If UBound(arr) > 0 Then
                Set txtDatei = FSO.createtextfile(DAtei, True)
                txtDatei.write (arr(1))
                txtDatei.Close
            End If
        End If
    Next
    
    
    
End Sub


Kopier die Dateien aber erstmal in einen anderen Ordner und teste an den Kopien.
ransi
Anzeige
AW: mit VBA/VBS Textdateien bearbeiten ?
19.08.2011 15:17:05
Tino
Hallo,
hier noch eine Variante.
Im Code gehe ich mal davon aus das sich die Excel-Datei mit dem Code im Ordner der Textdatei befindet,
wenn dies nicht so ist müsstest Du den Pfad anpassen. (siehe Kommentare)
Am Ende wird in der Tabelle1 noch ausgegeben ob die Zeilen im Text gefunden wurden. (ok. oder Fehler!)
Mach von den Textdateien zuerst eine Sicherung, sollte es mit dem Code nicht gehen ist nichts verloren.
Option Explicit

Sub Beispiel()
Dim F%, CountLen%
Dim strPath$, strDir$, sLines$, varInfo(), sInfo$
Dim ArrayFile()
Dim n&, nn&, nStart&, nLaenge&

Const TeilAbPos$ = "HIER IST DER VORSPANN ZU ENDE"
Const TeilBisPos$ = "HIER BIGINNT DER NACHSPANN"

'evtl. Pfad anpassen wo sich die Textdateien befinden 
'hier sind diese auch diese Excel-Datei liegt 
strPath = ThisWorkbook.Path

If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"

'*.txt- Dateien im Ordner suchen u. sammeln 
strDir = Dir$(strPath & "*.txt", vbNormal)
Do While strDir <> ""
    Redim Preserve ArrayFile(n)
    ArrayFile(n) = strPath & strDir
    n = n + 1
    strDir = Dir$()
Loop

If n > 0 Then
    CountLen = Len(strPath) + 1
    Redim varInfo(1 To n, 1 To 2)
    For n = Lbound(ArrayFile) To Ubound(ArrayFile)
        sInfo = "Fehler!" 'Fehler ist, Start oder Ende nicht gefunden 
        
        'Datei einlesen 
        F = FreeFile
        Open ArrayFile(n) For Binary As #F
        sLines = Space$(LOF(F))
        Get #F, , sLines
        Close
        
        'Text ausschneiden u. zurückschreiben 
        nStart = InStr(sLines, TeilAbPos)
        nLaenge = InStr(sLines, TeilBisPos) - 2
        If nStart > 0 And nLaenge > 0 Then
            nStart = nStart + Len(TeilAbPos) + 1
            nLaenge = nLaenge - nStart
            sLines = Trim$(Mid$(sLines, nStart, nLaenge))
            
            Open ArrayFile(n) For Output As #F
            Print #F, sLines
            Close #F
            
            sInfo = "ok."
        End If
        
        'Infos sammeln 
        varInfo(n + 1, 1) = Mid$(ArrayFile(n), CountLen, Len(ArrayFile(n)))
        varInfo(n + 1, 2) = sInfo
        sLines = ""
    Next n
    
    'Info in einer Tabelle ausgeben 
    With Tabelle1 'evtl. Tabelle anpassen 
        .Range("A:B").Delete 'Spalten löschen 
        .Cells(1, 1) = "Dateiname" 'Überschrift 
        .Cells(1, 2) = "Info" 'Überschrift 
        .Rows(1).Font.Bold = True 'Überschrift fett 
        'Ausgabe in Zelle 
        .Cells(2, 1).Resize(Ubound(varInfo), Ubound(varInfo, 2)) = varInfo
        .Range("A:B").EntireColumn.AutoFit
    End With
Else
    'Fehler keine Textdatei im Ordner 
    MsgBox "keine Textdatei gefunden!", vbExclamation
End If

End Sub
Gruß Tino
Anzeige
Super ihr 2, vielen Dank ,klappt owT
19.08.2011 22:43:49
Mandy

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige