vba combine or append multiple text files into one via multi select dialog in folder

vba :
What I need:
combine multiple text files into one
via multi select dialog in folder(current code) or maybe a listbox selection?



vba current code: for selecting a single file

Need to store multiple file names in textbox, or maybe listbox selection?
current code for selecting single file.
Dim intChoice As Integer
'Dim strPath As String
Dim strPath2 As String
Dim nCol As Long
'only allow the user to select one file
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
'Remove all other filters
Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
'Add a custom filter
Call Application.FileDialog(msoFileDialogOpen).Filters.Add( _
    "Text Files Only", "*.txt")
'make the file dialog visible to the user
intChoice = Application.FileDialog(msoFileDialogOpen).Show
'determine what choice the user made
If intChoice <> 0 Then
    'your code here
    'get the file path selected by the user
    strPath = Application.FileDialog( _
        msoFileDialogOpen).SelectedItems(1)
    'print the file path to sheet 1
    Me.TextBox2.Value = strPath
    'print the file path to sheet 1
    strPath2 = Left(strPath, Len(strPath) - 4) & "_Text_Modified.txt"
    Me.TextBox3.Value = strPath2
End If

Open in new window



Allows only a single selection and Writing
This code is only taking a single file
Const ForReading = 1, ForWriting = 2
Dim objFSO
Dim listFile, writeFile
Dim inLineRead, outLineWrite
Dim inArrLine
Dim inDelim, outDelim
Dim numberOfFields, outFieldNumber
'Dim delIn As Variant
Dim delout As Variant
Dim ctrl As Control
Dim x As Control
Dim txtFields As Integer
Dim cnt As Integer
Dim capName As String
Dim nCol As Long


UserForm1.Label4.Visible = True
cnt = 0
' lets determine which InPut delimiter is selected
          For Each x In InputGroup.Controls 'Loop through the option buttons
                                        'within the Frame
              If x.Value = True Then
                  'MsgBox x.Caption                  'Display the name of the selected
                    capName = x.Caption
                    cnt = 1
              End If                     'option button
          Next
If cnt = 0 Then
MsgBox "Select An Input Delimiter", vbCritical
cnt = 0
Exit Sub
End If





'Now lets determine the ascii value
If capName = "Tab" Then
delIn = Chr(9)
End If
If capName = "SemiColon" Then
delIn = Chr(59)
End If
If capName = "Comma" Then
delIn = Chr(44)
End If
If capName = "Space" Then
delIn = Chr(32)
End If
If capName = "Pipe" Then
delIn = Chr(124)
End If

delIn = delIn




cnt = 0
' lets determine which Output delimiter is selected
          For Each ctrl In OutPutGroup.Controls 'Loop through the option buttons
                                        'within the Frame
              If ctrl.Value = True Then
             '    MsgBox ctrl.Caption        'Display the name of the selected
                  capName = ctrl.Caption
                  cnt = 1
              End If                     'option button
          
          Next

If cnt = 0 Then
MsgBox "Select An Output Delimiter", vbCritical
cnt = 0
Exit Sub
End If




'Now lets determine the ascii value
If capName = "Tab" Then
delout = Chr(9)
End If
If capName = "SemiColon" Then
delout = Chr(59)
End If
If capName = "Comma" Then
delout = Chr(44)
End If
If capName = "Space" Then
delout = Chr(32)
End If
If capName = "Pipe" Then
delout = Chr(124)
End If

delout = delout



' number of fields
If Me.TextBox1.Text = "" Then
MsgBox "Please Choose a Number of Fields", vbCritical
Exit Sub
End If

txtFields = Me.TextBox1.Text


Set objFSO = CreateObject("Scripting.FileSystemObject")

'CHANGE THESE AS NEEDED
inDelim = delIn      'Chr(9) '<--Chr(9) is tab
outDelim = delout    '"|"

numberOfFields = txtFields  '  or nCol






'Set listFile = objFSO.OpenTextFile("C:\test.txt", ForReading) '<--incoming file
'Set writeFile = objFSO.OpenTextFile("C:\Temp\test_modified.txt", ForWriting, True) '<--outgoing file

Set listFile = objFSO.OpenTextFile(TextBox2.Text, ForReading) '<--incoming file
'Set writeFile = objFSO.OpenTextFile(TextBox3.Text, ForWriting, True) '<--outgoing file
Set writeFile = objFSO.OpenTextFile(TextBox3.Text, Forappending, True) '<--outgoing file




'Set up regex
Dim regEx
Set regEx = New RegExp
With regEx
    .MultiLine = False
    .Global = True
    .IgnoreCase = False
    .Pattern = "[^\x00-\x7F]" '<--pattern matching those pesky extended ASCII characters
End With

Do Until listFile.AtEndOfStream
    'Load up the line
    inLineRead = listFile.ReadLine
    
    'Get rid of extended ascii using the regex set up above
    inLineRead = regEx.Replace(inLineRead, "")
    
    'split the line, and write back out using the new delim
    inArrLine = Split(inLineRead, inDelim)
    
    'set some stuff for the loop
    firstField = True
    outLineWrite = ""
    outFieldNumber = 1
    
    'Loop through fields
    For Each inField In inArrLine
    
        'write out the value in the field
        If outFieldNumber <= numberOfFields Then
      'Add a delim if this isn't the first field
      If Not firstField Then
        outLineWrite = outLineWrite & outDelim
      Else
        firstField = False
      End If
            outLineWrite = outLineWrite & inField
        Else
            Exit For
        End If
    outFieldNumber = outFieldNumber + 1
    Next
        
    
    'Write it out only if there is something to write
    If Not Trim(outLineWrite) = "" Then writeFile.WriteLine outLineWrite
Loop

Open in new window




Thanks
fordraiders
LVL 3
FordraidersAsked:
Who is Participating?
 
Boyd (HiTechCoach) Trimmell, Microsoft Access MVPCommented:
Disclaimer: I am a Microsoft MVP for Access.  I am great with Access VBA.

To select multiple files you need to change this line

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False

Open in new window


to

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True

Open in new window




I would place the second code snippet in a function where you can pass the a file name and  process a single file.

Here is an example that loads a  list of selected files into an Array:


Dim FName As Variant
Dim N As Long

' get multiple .txt file names
FName = Application.GetOpenFilename(filefilter:= "Text Files Only, *.txt" , MultiSelect:=True)

' loop through array of file names
 If IsArray(FName) Then
       For N = LBound(FName) To UBound(FName)
                ' code here to do something with each file with path FName(N) 
                ' I would call the code to process a single file passing FName(N)
     Next
End If

Open in new window

0
 
FordraidersAuthor Commented:
worked great ! Thanks
0
 
Boyd (HiTechCoach) Trimmell, Microsoft Access MVPCommented:
You're welcome. Glad I could assist.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.