Fetching data from text files to excel

[pban92]

Hello,

1. I have 960 txt files each containing a single value.
2. The txt files are named as case001.txt, case002.txt,.....,case960.txt
2. I would like to make 10 excel files each containing 8x12 cells/array out of every 96 files over 960 files.

The following scripts should do the job but with no success.

Many many thanks in advance!

Sub ReadTextFiles()
    
    ' Make reference to library:
    ' Tools -> References -> Microsoft Scripting Runtime

    Dim iRow As Integer, iCol As Integer
    Dim iBooksCounter As Integer, iTextCounter As Integer
    Dim fso As New FileSystemObject
    Dim txt As TextStream, aFile As File
    Dim sContent As String, wkb As Workbook
    
    For Each aFile In fso.GetFolder(ThisWorkbook.Path).Files
        
        If fso.GetExtensionName(aFile.Name) = "txt" Then
            
            If iTextCounter Mod 96 = 0 Or iTextCounter = 0 Then
                iRow = 1: iCol = 1: iBooksCounter = iBooksCounter + 1
                If Not wkb Is Nothing Then
                    With wkb
                        .SaveAs Filename:=ThisWorkbook.Path & "\ExcelFile" & iBooksCounter & ".xlsx"
                        .Close SaveChanges:=True
                    End With
                End If
                Set wkb = Workbooks.Add
            End If
            
            Set txt = fso.OpenTextFile(Filename:=aFile.Path, IOMode:=ForReading)
            sContent = txt.ReadAll
            
            With wkb.Sheets(1)
                iCol = iCol + 1
                If iCol = 13 Then
                    iRow = iRow + 1: iCol = 1
                End If
                .Cells(iRow, iCol) = sContent
            End With
            
        End If
        
    Next

End Sub

 

[tweedle]

What's the problem?

(Looks like you might need to look at incrementing iTextCounter at some point)

 

[pban92]

Sorry for not stating actual problem.
On the execution the error is,

Compilation error:
User-defined type not defined

This line gets highlighted:
fso As New FileSystemObject

I got the scripts from this forum which did not work in my case.
Many thanks for further assistance!

 

[tweedle]

You need to add the reference to the scripting library
Alt+F11 to open IDE
Goto Menu Tools/References
Locate and Check the box next to "Microsoft Scripting Runtime"

 

[pban92]

Hi thanks for the check thing. It worked but not what was expected out of it which was a single xls file with 8x12 cells filled with the value from .tur files. It simply produced 96 more xls files from 96 tur files

 

[tweedle]

(Looks like you might need to look at incrementing iTextCounter at some point)

I think this will get you closer... (untested)
Rearranged the parts and incremented iTextCounter

Sub ReadTextFiles()
 
    ' Make reference to library:
    ' Tools -> References -> Microsoft Scripting Runtime
    Dim iRow As Integer, iCol As Integer
    Dim iBooksCounter As Integer, iTextCounter As Integer
    Dim fso As New FileSystemObject
    Dim txt As TextStream, aFile As File
    Dim sContent As String, wkb As Workbook
 
 
    For Each aFile In fso.GetFolder(ThisWorkbook.Path).Files
 
        If fso.GetExtensionName(aFile.Name) = "txt" Then
 
 
  'Initializer only 
            If iTextCounter = 0 
               Set wkb = Workbooks.Add
                iRow = 1: iCol = 1: iBooksCounter = iBooksCounter + 1
            End If
 
            'Collect the info 
            Set txt = fso.OpenTextFile(Filename:=aFile.Path, IOMode:=ForReading)
            sContent = txt.ReadAll
 
            'Store the info
            With wkb.Sheets(1)
                iCol = iCol + 1
                If iCol = 13 Then
                    iRow = iRow + 1: iCol = 1
                End If
                .Cells(iRow, iCol) = sContent
            End With
 
     'We collected a file, so increment counter 
     iTextCounter = iTextCounter + 1   
 
     'Are we done with this cube?   
     'If So, Close it and start another book 
            If iTextCounter Mod 96 = 0 Then
 
 
                If Not wkb Is Nothing Then
                    With wkb
                        .SaveAs Filename:=ThisWorkbook.Path & "\ExcelFile" & iBooksCounter & ".xlsx"
                        .Close SaveChanges:=True
                    End With
                End If
 
 
                'We only need a new workbook if we're not done with 960 files
                'We can only be this far in if we've completed a cube
                If iTextCounter <> 960 then 
                    Set wkb = Workbooks.Add
                    iRow = 1: iCol = 1: iBooksCounter = iBooksCounter + 1
                Else 
                    'Otherwise, be done 
                    Exit Sub 
                End if
            End If
 
        End If
 
    Next
End Sub

 

[pban92]

Thanks for taking time to modify it to my need. But I am too much of a noob to further modify it. It kept showing error.

 

[tweedle]

Tested rewrite + testing Subs.
caution: Sub CreateTestTextFiles will create text files in the current directory. DeleteTestTextFiles will Delete Files

The Excel running the macro needs to be in the same directory as the text files being read.

Sub ReadTextFiles()
 
    ' Make reference to library:
    ' Tools -> References -> Microsoft Scripting Runtime
    Dim iRow As Integer, iCol As Integer
    Dim iBooksCounter As Integer, iTextCounter As Integer
    Dim fso As New FileSystemObject
    Dim txt As TextStream, aFile As File
    Dim sContent As String, wkb As Workbook
 
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
    For Each aFile In fso.GetFolder(ThisWorkbook.Path).Files
        If fso.GetExtensionName(aFile.Name) = "txt" Then
 
            'Initializer only
            If iTextCounter = 0 Then
               Set wkb = Workbooks.Add
                iRow = 1: iCol = 1: iBooksCounter = iBooksCounter + 1
            End If
 
            'Collect the info
            Set txt = fso.OpenTextFile(Filename:=aFile.Path, IOMode:=ForReading)
            sContent = txt.ReadAll
 
            'Store the info
            With wkb.Sheets(1)
                .Cells(iRow, iCol) = sContent
                iCol = iCol + 1
                If iCol = 13 Then
                    iRow = iRow + 1: iCol = 1
                End If
                
            End With
 
     'We collected a file, so increment counter
     iTextCounter = iTextCounter + 1
 
     'Are we done with this cube?
     'If So, Close it and start another book
            If iTextCounter Mod 96 = 0 Then
 
                If Not wkb Is Nothing Then
                    With wkb
                        .SaveAs Filename:=ThisWorkbook.Path & "\ExcelFile" & iBooksCounter & ".xlsx"
                        .Close SaveChanges:=True
                    End With
                End If
 
                'We only need a new workbook if we're not done with 960 files
                'We can only be this far in if we've completed a cube
                If iTextCounter <> 960 Then
                    Set wkb = Workbooks.Add
                    iRow = 1: iCol = 1: iBooksCounter = iBooksCounter + 1
                Else
                    'Otherwise, be done
                    Exit For
                End If
            End If
 
        End If
 
    Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Sub CreateTestTextFiles()
    Dim fso As New FileSystemObject
    Dim txt As TextStream, aFile As File
Sheet1.Activate
With fso
    For FileIdx = 1 To 960
        .CreateTextFile "Case" & Format(FileIdx, "000") & ".txt", True
        Set f = fso.OpenTextFile("Case" & Format(FileIdx, "000") & ".txt", ForWriting, False, TristateFalse)
        f.Write FileIdx
        f.Close
        Application.StatusBar = FileIdx
    Next FileIdx
End With
Application.StatusBar = ""
End Sub
 
 
Sub DeleteTestTextFiles()
    Dim fso As New FileSystemObject
    Dim txt As TextStream, aFile As File
With fso
    For FileIdx = 1 To 960
        .DeleteFile "Case" & Format(FileIdx, "000") & ".txt", True
        Application.StatusBar = FileIdx
    Next FileIdx
End With
Application.StatusBar = ""
End Sub