title image


Smiley Re: TXT Dateien auslesen und neu zusammensetzen
Folgende zwei Functions in ein allgemeines Modul kopieren:





Public Function FileReadAll(strFileName As String) As String



' =============================================================================

' Funktion:

' =========

' Gibt den Inhalt der übergebenen Textdatei als String zurück

'

' Eingabeparameter:

' =================

' strFileName: Name der zu lesenden Datei

' =============================================================================



Const lngForReading = 1



Dim fso As Object

Dim fsoFile As Object

On Error GoTo FileReadAllErr

FileReadAll = ""

Set fso = CreateObject("Scripting.FileSystemObject")

Set fsoFile = fso.OpenTextFile(strFileName, lngForReading, False)

FileReadAll = fsoFile.ReadAll

fsoFile.Close

FileReadAllExit:

Set fsoFile = Nothing

Set fso = Nothing

Exit Function

FileReadAllErr:

MsgBox Err.Description, vbCritical, "FileReadAll: Fehler " & Err.Number & " aufgetreten!"

FileReadAll = ""

Resume FileReadAllExit

End Function









Public Function TextFileAppend(strText As String, _

strFileName As String, _

Optional bolCreate As Boolean = False)



' =============================================================================

' Funktion:

' =========

' Hängt den übergebenen String einer Textdatei an

'

' Eingabeparameter:

' =================

' strText: Anzuhängender Text

' strFileName: Name der zu beschreibenden Datei

' =============================================================================



Const lngForAppending = 8



Dim fso As Object

Dim fsoOutFile As Object





On Error GoTo TextFileAppendErr



Set fso = CreateObject("Scripting.FileSystemObject")

Set fsoOutFile = fso.OpenTextFile(strFileName, lngForAppending, bolCreate)

fsoOutFile.WriteLine strText

fsoOutFile.Close





TextFileAppendExit:

Set fsoOutFile = Nothing

Set fso = Nothing

Exit Function



TextFileAppendErr:

MsgBox Err.Description, vbCritical, "TextFileAppend: Fehler " & Err.Number & " aufgetreten!"

Resume TextFileAppendExit



End Function





Die aufrufende Prozedur könnte dann so aussehen:





Sub Test()

Const strSearchFld = "c:\data\exportBU\"

Const strTargetFile = "c:\data\exportBU\Alles.txt"

Dim fso As Scripting.FileSystemObject

Dim fsoFld As Scripting.Folder

Dim fsoFile As Scripting.File

Dim strTmp As String

Set fso = New Scripting.FileSystemObject

Set fsoFld = fso.GetFolder(strSearchFld)

For Each fsoFile In fsoFld.Files

strTmp = FileReadAll(fsoFile.Path)

TextFileAppend strTmp, strTargetFile, True

Next fsoFile

Set fsoFile = Nothing

Set fsoFld = Nothing

Set fso = Nothing

End Sub





Was da passiert ist folgendes:



Eine Schleife durchläuft alle Dateien, die sie in c:\data\exportBU\ findet. Jede wird einzeln geöffnet und in die Variable strTmp eingelesen. Der Inhalt von strTmp wird anschließend in die Datei c:\data\exportBU\Alles.txt weggeschrieben, also per Append dort angehängt.



Schönen Gruß,

Eric

Spotlight-Kicktipp gestartet!

Steig ein und trete mit Deinem Bundesliga-Tipp gegen die Besten an! :o)

http://www.kicktipp.de/spotlight/



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: