How to get data from text file

[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.

Could anybody pls suggest me how to write a vb scripts to do that?

Many many thanks in advance!

 

[Sektor]

Try this. It's assumed that all text files are in the same folder as workbook. Adjust paths as you wish.

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
                        .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

 

[Sektor]

Change this line:

.SaveAs Filename:=ThisWorkbook.Path & "\ExcelFile" & iBooksCounter

to this

.SaveAs Filename:=ThisWorkbook.Path & "\ExcelFile" & iBooksCounter [B][COLOR="Red"]& ".xlsx"[/COLOR][/B]

 

[pban92]

Thank you so much for the scripts.
However, I failed to run it successfully.
I tried the scripts on a set of files which
1. has .tur extension instead of .txt
2. changed the .SaveAs line
3. all my files are in the same folder including the workbook
4. I changed .xlsx to .xls as im using office2003.
Any further suggestion? Regards!

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) = "tur" 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 & ".xls"
                        .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