Loop through records and create .txt files from batches-CodePudding

I have below code where I would like to create .txt files only instead of excel files. Below will take records from Sheet1 separate them by 47k rows, paste it into template and will create .txt file (format without commas, print method, not overwriting existing txt files in the folder, each filename to be "Part"& "sequence number", for ex. "Part 1" ) and then repeat until all records from Sheet1 gone into txt files. I need help with creating a loop which will create txt file & paste the records into txt files

  Sub FillTemplate(c As Long)
    Dim Lrow1A, c, start, finish as Long
    Dim TV As Variant
    
    ' this part divides all records by 47k and rounds up
    Lrow1A = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
    
    TV = Lrow1A / 47000
    TV = Application.WorksheetFunction.RoundUp(TV, 0)
    
    ' this part copies records (divided by batches of 47k) into template
    start = ((c - 1) * 47000)   2
    finish = (c * 47000)   1
    
    Worksheets("Sheet1").Range(Cells(start, 1), Cells(finish, 1)).Copy
    Worksheets("Template").Cells(1, 9).PasteSpecial Paste:=xlPasteValues
    End Sub
    
    Sub new_template(c As Long)
    ' this part saves template in new excel and then creates .txt version
    'I need help with amending all this part down below as I do not need excel files to be created but .txt files
    
    Dim wb As Workbook
    Dim WBname, WBname1 As String
    
    Workbooks.Add
    Set wb = ActiveWorkbook
    wb.SaveAs "\\D\folder\" & "UploadTest.xls"
    
    WBname = wb.FullName 'create new workbook to rename previous one
    
    wb.SaveAs "\\D\folder\Part " & c & ".xlsx"
    WBname1 = ActiveWorkbook.Name
    Kill WBname
    
    Workbooks("Sum.xlsm").Activate
    Worksheets("Template").Select
    Range("A:R").Select
    Selection.Copy
    Workbooks(WBname1).Activate
    Columns(1).Select
    ActiveSheet.Paste
    
    ActiveWorkbook.SaveAs "\\D\folder\Part " & c & ".txt", FileFormat:=xlTextWindows
    
    ActiveWorkbook.Close
    End Sub
    
    Sub Finalcode()
    
    Dim c As Long
    For c = 1 To TV

Call FillTemplate(c)
Call new_template(c)


Next c

End Sub

CodePudding user response：

Set fs = CreateObject("scripting.filesystemobject")
file1 = ThisWorkbook.Name

file1 = Replace(file1, ".xlsm", "")
Debug.Print file1

filepath = "C:\Billing3\"    '<<< change me
j1 = 1
file2 = filepath & file1 & j1 & ".txt"
Set outfile = fs.OpenTextFile(file2, 8)
lrow = 250000
Sheets(1).Select

For i1 = 1 To lrow
    text1 = Cells(i1, 1)
    outfile.WriteLine text1

    If Int(i1 / 47000) = i1 / 47000 Then
        outfile.Close
        j1 = j1   1
        file2 = filepath & file1 & j1 & ".txt"
        Set outfile = fs.CreateTextFile(file2, 8)
    End If
    
Next
outfile.Close`

Filesystemobject can be used to deal with text and csv files The above code will copy column A from 1st sheet in batches of 47000 up to a maximum of lrow (set at 250000 which can be changed)

CodePudding user response：

Sub new_template(c As Long)

Set fs = CreateObject("scripting.filesystemobject")
file2 = "\\D\folder\Part " & c & ".txt"
Set outfile = fs.OpenTextFile(file2, 8)

Worksheets("Template").Select
For r1 = 1 to 47000
    Text1 = “”
    For c1 = 1 to 18   ‘code is for column 1 = A to 18 = R, can adjust this
        Text1 = Text1 & vbtab & cells(r1, c1)   ‘vbtab is the tab delimiter
    Next
    Outfile.writeline Text1
Next
Outfile.close

End sub