Visual Basic > ActiveX Controls

More To One

More To One

Option Explicit
  Dim fso As New FileSystemObject
  
Private Sub Form_Load()
  Dim strPath As String
  
  strPath = Command()
  If Len(strPath) <> 0 And fso.FolderExists(strPath) Then AddAllFiles strPath

  Unload Me
End Sub

Public Function AddAllFiles(ByVal strLoc As String)
  Dim objFolder As Folder
  Dim AFile As File
  Dim FileNum As Integer, filDesc As Integer
  Dim strOutFile As String, str1 As String, str2 As String

On Error GoTo ErrorHandler
  
  If fso.FolderExists(strLoc) Then
    Set objFolder = fso.GetFolder(strLoc)
    strOutFile = strLoc & "\Total.dat"
    FileNum = FreeFile

    Open strOutFile For Output As #FileNum

      For Each AFile In objFolder.Files
        filDesc = FreeFile
        Open AFile.Path For Input As #filDesc
          Do Until EOF(filDesc)
            Line Input #filDesc, str1
            If Len(str2) = 0 Then
              str2 = str2 & str1
            Else
              str2 = str2 & vbCrLf & str1
            End If
          Loop
          Print #FileNum, str2
        Close #filDesc
        str1 = "": str2 = ""
      Next
    Close #FileNum
  
  Else
    MsgBox "Location " & strLoc & " doesn't exist!", vbCritical, "Function AddAllFiles"
  End If
  
ErrorHandler:
         
End Function