Merging Text Files with Excel VBA

[pingme89]

I have created some code but for some reason, whenever a text file is looped, it generates an error saying the file is already open even though it is not.

Essentially I am trying to loop through all text files in a specified folder and copy all contents from all the files and combine them into 1 output file.

I have tried using Shell command to accomplish the same thing but the problem is my AntiVirus software thinks it is malicious and deletes the file. So I don't want to use the Shell command.

Here is my code. Can someone tell me what I am doing wrong?

Private Sub TestMerge()
Dim FSO

Dim TextFile As Integer
Dim FilePath As String
Dim OutPath As String
Dim InPath As String
Dim FileContent As String

InPath = "C:\Users\phili\Desktop\Access Templates\AnkurDB_Code\"
Set FSO = New FileSystemObject
' get the directory you want
Set Folder = FSO.GetFolder(InPath)
'File Path of Text File

OutPath = "C:\Users\BB\Desktop\Access Templates\DB_Code\" & "Module1.txt"

'Determine the next file number available for use by the FileOpen function
  OutFile = FreeFile

'Open the text file
  Open OutPath For Output As OutFile


  For Each File In Folder.Files
      InFile = FreeFile
      Open File For Input As InFile
    If Right(File, 3) = "txt" Then
    'Store file content inside a variable
      FileContent = Input(LOF(InFile), InFile)   ' LOCATION OF ERROR.
      Print #OutFile, FileContent
    End If
    
    
    'Close Text File
      Close TextFile

Next File

Close OutFile


End Sub

 

[HaHoBe]

Hi pingme89,

you open the textfiles by

      Open File For Input As InFile

while you close any other file with

      Close TextFile

instead of what I would expect

      Close InFile

Ciao,
Holger

 

[pingme89]

Hi pingme89,

you open the textfiles by

      Open File For Input As InFile

while you close any other file with

      Close TextFile

instead of what I would expect

      Close InFile

Ciao,
Holger

Thanks but the error occurs before that line of code.
Fixing that won't solve the error.

 

[HaHoBe]

Hi pingme,

you have added the library "Microsoft Scripting Runtime" under Tools/References in the IDE?

Code works fine for me when changing the paths to my needs:

Private Sub TestMerge_mod()
' https://www.mrexcel.com/board/threads/merging-text-files-with-excel-vba.1225621/

' needed additional library:   Microsoft Scripting Runtime

Dim FSO As FileSystemObject
Dim OutFile As Integer
Dim InFile As Integer
Dim FilePath As String
Dim OutPath As String
Dim InPath As String
Dim FileContent As String
Dim Folder As FileSystemObject.Folder
Dim File As FileSystemObject.File

InPath = "C:\Users\phili\Desktop\Access Templates\AnkurDB_Code\"
Set FSO = New FileSystemObject
' get the directory you want
Set Folder = FSO.GetFolder(InPath)
'File Path of Text File
OutPath = "C:\Users\BB\Desktop\Access Templates\DB_Code\" & "Module1.txt"

'Determine the next file number available for use by the FileOpen function
OutFile = FreeFile
'Open the text file
Open OutPath For Output As OutFile

For Each File In Folder.Files
  InFile = FreeFile
  Open File For Input As InFile
  If Right(File, 3) = "txt" Then
    'Store file content inside a variable
    FileContent = Input(LOF(InFile), InFile)   ' LOCATION OF ERROR.
    Print #OutFile, FileContent
  End If
  'Close Text File
  Close InFile
Next File
Close OutFile

End Sub

Ciao,
Holger