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