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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Boyd (HiTechCoach) Trimmell, Microsoft Access MVPDesigner and DeveloperCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
FordraidersAuthor Commented:
worked great ! Thanks
0
Boyd (HiTechCoach) Trimmell, Microsoft Access MVPDesigner and DeveloperCommented:
You're welcome. Glad I could assist.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.