Tipp 0286 Text-Dateien in einer Datei speichern (FSO)
Autor/Einsender:
Datum:
  Angie
09.11.2002
Entwicklungsumgebung:   VB 6
Ab Visual Basic 6 steht standardmäßig das FileSystemObject (FSO) zur Verfügung, mit dem auch ein komfortabler Umgang mit Dateien möglich ist. In diesem Beispiel werden die in einer ListBox ausgewählten Text-Dateien nacheinander eingelesen und zusammen in einer neuen Datei gespeichert.
 
Option Explicit

Private mstrPath As String

Private Sub Form_Load()
  Dim strFileName As String
  Dim i As Integer

  mstrPath = App.Path & "\"

  strFileName = Dir(mstrPath & "*.txt")
  While Len(strFileName) <> 0
    lstFiles.AddItem strFileName
    strFileName = Dir()
  Wend

  lblMsg.Caption = vbNullString
  txtNewFile.Text = "NeueDatei.txt"
End Sub

Private Sub cmdSpeichern_Click()
  Dim strNewFile As String
  Dim avFileList() As Variant

  Dim intCount As Integer
  Dim i As Integer

  If Len(Trim$(txtNewFile.Text)) = 0 Then
    MsgBox "Der Dateiname für die neue Datei fehlt!", _
          vbOKOnly + vbInformation, Me.Caption
    txtNewFile.SetFocus
    Exit Sub
  Else
    strNewFile = Trim$(txtNewFile.Text)
  End If

  intCount = 0
  With lstFiles
    For i = 0 To .ListCount - 1
      If .Selected(i) Then
        intCount = intCount + 1
        ReDim Preserve avFileList(1 To intCount)
        avFileList(intCount) = mstrPath & .List(i)
      End If
    Next i
  End With

  Select Case intCount
    Case 0
      lblMsg.Caption = "Es wurden keine Dateien ausgewählt !"

    Case 1
      lblMsg.Caption = "Es wurde nur eine Datei ausgewählt !"

    Case Else
      If JoinFiles(mstrPath & strNewFile, avFileList) Then
        lblMsg.Caption = _
            "Die ausgewählten Dateien wurden in der Datei " & _
            strNewFile & " gespeichert !"
      Else
        lblMsg.Caption = "Beim Speichern der Dateien ist " & _
            "ein Fehler aufgetreten !"
      End If
  End Select
End Sub

Private Function JoinFiles(ByVal vstrNewFile As String, _
              ByVal vFileList As Variant) As Boolean

  Dim fso As New FileSystemObject
  Dim fsoSourceFile As TextStream
  Dim fsoNewFile As TextStream

  Dim i As Integer

  On Error GoTo err_handler
  Set fsoNewFile = fso.OpenTextFile(vstrNewFile, ForWriting, True)

  For i = LBound(vFileList) To UBound(vFileList)
    Set fsoSourceFile = fso.OpenTextFile(vFileList(i), ForReading)
    fsoNewFile.Write fsoSourceFile.ReadAll & vbCrLf
    fsoSourceFile.Close
    Set fsoSourceFile = Nothing
  Next i

  fsoNewFile.Close
  Set fsoNewFile = Nothing

  JoinFiles = True
  Exit Function

err_handler:
  JoinFiles = False
  Exit Function
End Function
 
Weitere Links zum Thema
Laufwerks-Informationen ermitteln (FSO)
Rekursives Suchen von Dateien (FSO)
Hinweis
Um diesen Tipp ausführen zu können, muss zur Entwurfszeit die Microsoft Scripting Runtime-Bibliothek (SCRRUN.DLL) in das Projekt eingebunden werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (4,4 kB) Downloads bisher: [ 2216 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Freitag, 9. September 2011