Combine all text file in directory into one file.

[Rich]

Hello,

I am trying to adapt the following code posted by Jim Rech.

Sub a()
Dim SrcFiles, CurrSrc As String
Dim DestFile As String, Counter As Integer
Dim TextLine As String
SrcFiles = Array("c:\File1.txt", "c:\File2.txt")
Open "c:\file3.txt" For Output As #1
For Counter = 0 To UBound(SrcFiles)
Open SrcFiles(Counter) For Input As #2
Do While Not EOF(2)
Line Input #2, TextLine
Print #1, TextLine
Loop
Close #2
Next
Close #1
End Sub

I need to do the following. I need to combine all the text files
in directory "C:\ECPJM" into one text file called "Combined.txt". Any
help would be greatly appreciated.

Thanks,

Rich

 

[Tom Ogilvy]

Sub a()
Dim SrcFiles() as String, CurrSrc As String
Dim DestFile As String, Counter As Integer
Dim TextLine As String, sName as String, i as Long
' SrcFiles = Array("c:\File1.txt", "c:\File2.txt")
Redim SrcFiles(1 to 1000)
On Error Resume Next
Kill "C:\ECPJM\combined.txt"
On Error goto 0
sName = Dir("C:\ECPJM\" & "*.txt")
i = 0
do while sName <> ""
i = i + 1
SrcFiles(i) = sName
sName = Dir
Loop
Redim SrcFiles(1 to i)
Open "c:\ECPJM\combined.txt" For Output As #1
For Counter = 0 To UBound(SrcFiles)
Open SrcFiles(Counter) For Input As #2
Do While Not EOF(2)
Line Input #2, TextLine
Print #1, TextLine
Loop
Close #2
Next
Close #1
End Sub

 

[Tom Ogilvy]

Whoops, change

Open SrcFiles(Counter) For Input As #2

to

Open "C:\ECPJM\" & SrcFiles(Counter) For Input As #2

 

[Rich]

Hi Tom,

I changed the code to what you have listed and I get a
Run-Time error '9': Subscript out of range. If I Debug it highlights:

Open "C:\ECPJM\" & SrcFiles(Counter) For Input As #2

Any ideas on this error? I greatly appreciate your help.

Thanks,

Rich


Sub a()
Dim SrcFiles() As String, CurrSrc As String
Dim DestFile As String, Counter As Integer
Dim TextLine As String, sName As String, i As Long
' SrcFiles = Array("c:\File1.txt", "c:\File2.txt")
ReDim SrcFiles(1 To 1000)
On Error Resume Next
Kill "C:\ECPJM\combined.txt"
On Error GoTo 0
sName = Dir("C:\ECPJM\" & "*.txt")
i = 0
Do While sName <> ""
i = i + 1
SrcFiles(i) = sName
sName = Dir
Loop
ReDim SrcFiles(1 To i)
Open "c:\ECPJM\combined.txt" For Output As #1
For Counter = 0 To UBound(SrcFiles)
Open "C:\ECPJM\" & SrcFiles(Counter) For Input As #2
Do While Not EOF(2)
Line Input #2, TextLine
Print #1, TextLine
Loop
Close #2
Next
Close #1
End Sub

 

[Tom Ogilvy]

For Counter = 0 To UBound(SrcFiles)

should be


For Counter = 1 To UBound(SrcFiles)

 

[Harlan Grove]

I need to do the following. I need to combine all the text files
in directory "C:\ECPJM" into one text file called "Combined.txt". Any
help would be greatly appreciated.

While this may offend the VBA purists, I'd recommend searching for the
ShellAndWait function in the Google Groups archive for this newsgroup, and
using it to run


Call ShellAndWait(Environ("ComSpec") & " /c copy " & _
DirectoryPath & "\*.txt " & DirectoryPath & "\x.x")

Name DirectoryPath & "\x.x" As DirectoryPath & "\Combined.txt"


In general, Windows's command interpreter's COPY command is the best tool
available for combining text files. Using anything else is pointless wheel
reinvention.

 

[Rich]

I changed the code to the following, but am getting a run-time error
76 "Path not found" on the line:
Open "C:\ECPJM\" & SrcFiles(Counter) For Input As #2

However the path is spelled correctly and I even copied it from
Windows Explorer. Any ideas?

Sub a()
Dim SrcFiles() As String, CurrSrc As String
Dim DestFile As String, Counter As Integer
Dim TextLine As String, sName As String, i As Long
ReDim SrcFiles(1 To 1000)
On Error Resume Next
Kill "C:\ECPJM\combined.txt"
On Error GoTo 0
sName = Dir("C:\ECPJM\" & "*.txt")
i = 0
Do While sName <> ""
i = i + 1
SrcFiles(i) = sName
sName = Dir
Loop
ReDim SrcFiles(1 To i)
Open "C:\DELL\t\combined.txt" For Output As #1
For Counter = 1 To UBound(SrcFiles)
Open "C:\ECPJM\" & SrcFiles(Counter) For Input As #2
Do While Not EOF(2)
Line Input #2, TextLine
Print #1, TextLine
Loop
Close #2
Next
Close #1
End Sub

 

[Harlan Grove]

I changed the code to the following, but am getting a run-time error
76 "Path not found" on the line:
Open "C:\ECPJM\" & SrcFiles(Counter) For Input As #2

However the path is spelled correctly and I even copied it from
Windows Explorer. Any ideas?

The problem may be interpretting 'path'. By 'path' do you mean just the
"C:\ECPJM\" piece, i.e., the directory path? If so, that's one problem. The term
'path' in this context means the file's full path name. Try adding a statement
just above this like

Debug.Print Counter, "C:\ECPJM\" & SrcFiles(Counter)

to see what the file's full pathname appears to be to Excel/VBA. I suspect the
segment

Do While sName <> ""
i = i + 1
SrcFiles(i) = sName
sName = Dir
Loop
ReDim SrcFiles(1 To i)

is the source of the problem. Try changing the ReDim statement to

ReDim Preserve SrcFiles(1 To i)

 

[Rich]

"Rich" wrote...

I changed it to the following and got it to work. Thanks for all the
help everyone.

Public Sub CombineTextFiles()
Dim SrcFiles() As String, CurrSrc As String
Dim DestFile As String, Counter As Integer
Dim TextLine As String, sName As String, i As Long
Dim SrcTag As String, DestDir As String

ReDim SrcFiles(1 To 1000)
DestFile = "C:\ECPJM\combined.txt"
DestDir = "C:\ECPJM\"

On Error Resume Next
Kill DestFile

On Error GoTo 0
SrcTag = "C:\ECPJM\*.txt"
sName = Dir(SrcTag)

i = 0
Do While sName <> ""
i = i + 1
SrcFiles(i) = sName
sName = Dir
Loop
If i > 0 Then
' Need preserve or you lose everything added to the array
ReDim Preserve SrcFiles(1 To i)
Else
MsgBox "There are no files that match " & SrcTag
Exit Sub
End If

On Error Resume Next
Open DestFile For Output As #1
If Err.Number <> 0 Then
MsgBox "Destination file '" & DestFile & "' cannot be opened. Check"
to make sure file exists."

MsgBox "Destination file '" & DestFile & "' cannot be opened. Check to
make sure file exists."
Exit Sub
End If
For Counter = 1 To UBound(SrcFiles)
On Error Resume Next
Open DestDir & SrcFiles(Counter) For Input As #2
If Err.Number <> 0 Then
MsgBox "File '" & DestDir & SrcFiles(Counter) & "' cannot be"
opened. Check to make sure file exists."

MsgBox "File '" & DestDir & SrcFiles(Counter) & "' cannot be opened.
Check to make sure file exists."
Exit Sub
End If
Do While Not EOF(2)
Line Input #2, TextLine
Print #1, TextLine
Loop
Close #2
Next
Close #1

MsgBox "Complete.", vbInformation
End Sub