回圈遍歷記錄并批量創建.txt檔案

我有下面的代碼，我只想創建 .txt 檔案而不是 excel 檔案。下面將Sheet1中的記錄以47k行分開，粘貼到模板中，將創建.txt檔案（格式不帶逗號，列印方式，不覆寫檔案夾中現有的txt檔案，每個檔案名為“Part”&“sequence number” ”，例如“第 1 部分”），然后重復直到 Sheet1 中的所有記錄都進入 txt 檔案。我需要幫助創建一個回圈，該回圈將創建 txt 檔案并將記錄粘貼到 txt 檔案中

     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)

' Need help here: How to make macro create new text files? 
'at the moment it overwrites existing text files in a folder
        
        Dim wb As Workbook
        Dim WBname, WBname1 As String
        
        Workbooks.Add
        Set wb = ActiveWorkbook
        
        WBname = wb.FullName 'create new workbook to rename previous one
        
        WBname1 = ActiveWorkbook.Name
        
        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

uj5u.com熱心網友回復：

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 可用于處理文本和 csv 檔案 上面的代碼將從第一張作業表中的 A 列分批復制 47000 到最大 lrow（設定為 250000 可以更改）

uj5u.com熱心網友回復：

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 = cells(r1, 1)   'cell in row r1, column 1   (or A)
    For c1 = 2 to 18   ‘run from columns 2 to 18  (B to R)
        Text1 = Text1 & vbtab & cells(r1, c1)   ‘vbtab is the tab delimiter
    Next
        'Text1=left(Text1, Len(Text1)-1) 'remove last tab which is not be used
    Outfile.writeline Text1
Next
Outfile.close

End sub

標籤：擅长 vba 苹果系统

上一篇：如何在組合框vba中過濾資料

下一篇：VBA中日期格式的區別