使用vbscript将未定义的数据行从文本文件转换为excel
我创build了这个代码到目前为止，这只是为定义的行数，因为我们为每个标题列设置计数器。如果新批次的文件来了新的行数？ 如何开始创build这个代码？
Dim objFSO Dim TextFile Dim TextRead Dim Line, Line1, Line2, Line3 Dim Count 'Open the spreadsheet using the excel application object ExcelFilePath = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\Output.xlsx" Set objExcel = CreateObject("Excel.Application")'Creating excel object Set objWB = objExcel.Workbooks.Open(ExcelFilePath) 'Creating workbook object Set SheetObject = objWB.Worksheets("Sheet1") 'worksheets are a member of workbooks, not the Excel Application (Creating sheet object) 'open the text file Const ForReading = 1 'Constant declared so that can be used throughout the script 'Name of the text file that need to be convert TextFile = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\HRILOANDIC20170601.txt" 'Create File system object set objFSO = CreateObject("Scripting.FileSystemObject") 'set the text file to read and open it in read-only mode set TextRead = objFSO.OpenTextFile(TextFile,ForReading) CountHeader = 2 'to set row number for Excel paste CountDetail = 4 CountTrailer = 28 SheetObject.Columns(1).NumberFormat = "@" SheetObject.Columns(2).NumberFormat = "@" SheetObject.Columns(3).NumberFormat = "@" SheetObject.Columns(4).NumberFormat = "@" SheetObject.Columns(5).NumberFormat = "@" SheetObject.Columns(6).NumberFormat = "@" SheetObject.Columns(7).NumberFormat = "@" SheetObject.Columns(8).NumberFormat = "@" SheetObject.Columns(9).NumberFormat = "@" SheetObject.Columns(10).NumberFormat = "@" SheetObject.Columns(11).NumberFormat = "@" SheetObject.Columns(12).NumberFormat = "@" SheetObject.Columns(13).NumberFormat = "@" SheetObject.Columns(14).NumberFormat = "@" SheetObject.Columns(15).NumberFormat = "@" SheetObject.Cells(1, 1).Value = "Record Type" SheetObject.Cells(1, 2).Value = "Sequence No" SheetObject.Cells(1, 3).Value = "Contract No" SheetObject.Cells(1, 4).Value = "Creation By" SheetObject.Cells(1, 5).Value = "Transaction Date" SheetObject.Cells(1, 6).Value = "Total Record" SheetObject.Cells(1, 7).Value = "Total Amount" SheetObject.Cells(1, 8).Value = "Source" SheetObject.Cells(1, 9).Value = "Filler" SheetObject.Cells(3, 1).Value = "Record Type" SheetObject.Cells(3, 2).Value = "Sequence No" SheetObject.Cells(3, 3).Value = "Contract No" SheetObject.Cells(3, 4).Value = "Payment Type" SheetObject.Cells(3, 5).Value = "Settlement Type" SheetObject.Cells(3, 6).Value = "Effective Date" SheetObject.Cells(3, 7).Value = "Credit Account No." SheetObject.Cells(3, 8).Value = "Cr. Transaction Amount" SheetObject.Cells(3, 9).Value = "Loan Type" SheetObject.Cells(3, 10).Value = "Bank Employee ID" SheetObject.Cells(3, 11).Value = "ID Number" SheetObject.Cells(3, 12).Value = "ID Type Code" SheetObject.Cells(3, 13).Value = "Bank Employee Name" SheetObject.Cells(3, 14).Value = "HRIS Process Status" SheetObject.Cells(3, 15).Value = "Total Record" SheetObject.Cells(3, 16).Value = "CIF Number" SheetObject.Cells(3, 17).Value = "Account Branch" SheetObject.Cells(27, 1).Value = "Record Type" SheetObject.Cells(27, 2).Value = "Sequence No" SheetObject.Cells(27, 3).Value = "Contract No" SheetObject.Cells(27, 4).Value = "Total Record" SheetObject.Cells(27, 5).Value = "Total Amount" SheetObject.Cells(27, 6).Value = "Filler" Do Until TextRead.AtEndOfStream Line = TextRead.ReadLine If Left(Line, 1) = "H" Then SheetObject.Cells(CountHeader, 1).Value = Mid(Line, 1, 1) SheetObject.Cells(CountHeader, 2).Value = Mid(Line, 2, 9) SheetObject.Cells(CountHeader, 3).Value = Mid(Line, 11, 19) SheetObject.Cells(CountHeader, 4).Value = Mid(Line, 30, 1) SheetObject.Cells(CountHeader, 5).Value = Mid(Line, 31, 8) SheetObject.Cells(CountHeader, 6).Value = Mid(Line, 39, 9) SheetObject.Cells(CountHeader, 7).Value = Mid(Line, 48, 17) SheetObject.Cells(CountHeader, 8).Value = Mid(Line, 65, 2) SheetObject.Cells(CountHeader, 9).Value = Mid(Line, 67, 334) CountHeader = CountHeader + 1 ElseIf Left(Line, 1) = "D" Then SheetObject.Cells(CountDetail, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A SheetObject.Cells(CountDetail, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b SheetObject.Cells(CountDetail, 3).Value = Mid(Line, 11, 19) 'HeaderContractNo to column C SheetObject.Cells(CountDetail, 4).Value = Mid(Line, 30, 10) SheetObject.Cells(CountDetail, 5).Value = Mid(Line, 40, 1) SheetObject.Cells(CountDetail, 6).Value = Mid(Line, 41, 8) SheetObject.Cells(CountDetail, 7).Value = Mid(Line, 49, 19) SheetObject.Cells(CountDetail, 8).Value = Mid(Line, 68, 1) SheetObject.Cells(CountDetail, 9).Value = Mid(Line, 69, 17) SheetObject.Cells(CountDetail, 10).Value = Mid(Line, 86, 10) SheetObject.Cells(CountDetail, 11).Value = Mid(Line, 96, 40) SheetObject.Cells(CountDetail, 12).Value = Mid(Line, 136, 40) SheetObject.Cells(CountDetail, 13).Value = Mid(Line, 176, 3) SheetObject.Cells(CountDetail, 14).Value = Mid(Line, 179, 200) SheetObject.Cells(CountDetail, 15).Value = Mid(Line, 379, 1) SheetObject.Cells(CountDetail, 16).Value = Mid(Line, 380, 19) SheetObject.Cells(CountDetail, 17).Value = Mid(Line, 399, 5) CountDetail = CountDetail + 1 ElseIf Left(Line, 1) = "T" Then SheetObject.Cells(CountTrailer, 1).Value = Mid(Line, 1, 1) SheetObject.Cells(CountTrailer, 2).Value = Mid(Line, 2, 9) SheetObject.Cells(CountTrailer, 3).Value = Mid(Line, 30, 9) SheetObject.Cells(CountTrailer, 4).Value = Mid(Line, 39, 17) SheetObject.Cells(CountTrailer, 5).Value = Mid(Line, 65, 2) SheetObject.Cells(CountTrailer, 6).Value = Mid(Line, 56, 354) CountTrailer = CountTrailer + 1 Else 'Error Handling.. End If 'to move down the Excel row to paste for each line in the text fix Loop 'Save and quit objWB.Save objWB.Close objExcel.Quit 
由于您的数据总是以相同的模式出现在所有H行的第一行，然后是D行，然后是T行，您可以使用一个variables来计算行，然后检查第一次D或T行来添加标题。 我做了一个pseudo-Booleanvariables来确定何时为D和T添加标题。 H标题在第1行是不变的。
完全testing代码：
Dim objFSO Dim TextFile Dim TextRead Dim Line, Line1, Line2, Line3 Dim Count 'Open the spreadsheet using the excel application object ExcelFilePath = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\Output.xlsx" Set objExcel = CreateObject("Excel.Application")'Creating excel object objExcel.visible = true Set objWB = objExcel.Workbooks.Open(ExcelFilePath) 'Creating workbook object Set SheetObject = objWB.Worksheets("Sheet1") 'worksheets are a member of workbooks, not the Excel Application (Creating sheet object) 'open the text file Const ForReading = 1 'Constant declared so that can be used throughout the script 'Name of the text file that need to be convert TextFile = "C:\Users\MOHDSABRY\Desktop\Converter\taskCon\HRILOANDIC20170601.txt" 'Create File system object set objFSO = CreateObject("Scripting.FileSystemObject") 'set the text file to read and open it in read-only mode set TextRead = objFSO.OpenTextFile(TextFile,ForReading) row = 2 'start with row to set cell values With SheetObject 'format column as text .Range(.Columns(1),.Columns(15)).NumberFormat = "@" 'set `H` headers since its always row 1 .Cells(1, 1).Value = "Record Type" .Cells(1, 2).Value = "Sequence No" .Cells(1, 3).Value = "Contract No" .Cells(1, 4).Value = "Creation By" .Cells(1, 5).Value = "Transaction Date" .Cells(1, 6).Value = "Total Record" .Cells(1, 7).Value = "Total Amount" .Cells(1, 8).Value = "Source" .Cells(1, 9).Value = "Filler" Do Until TextRead.AtEndOfStream Line = TextRead.ReadLine If Left(Line,1) = "H" Then .Cells(row, 1).Value = Mid(Line, 1, 1) .Cells(row, 2).Value = Mid(Line, 2, 9) .Cells(row, 3).Value = Mid(Line, 11, 19) .Cells(row, 4).Value = Mid(Line, 30, 1) .Cells(row, 5).Value = Mid(Line, 31, 8) .Cells(row, 6).Value = Mid(Line, 39, 9) .Cells(row, 7).Value = Mid(Line, 48, 17) .Cells(row, 8).Value = Mid(Line, 65, 2) .Cells(row, 9).Value = Mid(Line, 67, 334) row = row +1 ElseIf Left(Line,1) = "D" Then Dim bD 'as Boolean If Not bD Then 'means its the first D row so set headers 'now set 'D' headers because 'h' is finished .Cells(row, 1).Value = "Record Type" .Cells(row, 2).Value = "Sequence No" .Cells(row, 3).Value = "Contract No" .Cells(row, 4).Value = "Payment Type" .Cells(row, 5).Value = "Settlement Type" .Cells(row, 6).Value = "Effective Date" .Cells(row, 7).Value = "Credit Account No." .Cells(row, 8).Value = "Cr. Transaction Amount" .Cells(row, 9).Value = "Loan Type" .Cells(row, 10).Value = "Bank Employee ID" .Cells(row, 11).Value = "ID Number" .Cells(row, 12).Value = "ID Type Code" .Cells(row, 13).Value = "Bank Employee Name" .Cells(row, 14).Value = "HRIS Process Status" .Cells(row, 15).Value = "Total Record" .Cells(row, 16).Value = "CIF Number" .Cells(row, 17).Value = "Account Branch" 'add 1 row to paste data again row = row + 1 'set variable so code knows headers have been set bD = True End If .Cells(row, 1).Value = Mid(Line, 1, 1) 'HeaderRecordType to column A .Cells(row, 2).Value = Mid(Line, 2, 9) 'ValueHeaderSequenceNo to column b .Cells(row, 3).Value = Mid(Line, 11, 19) 'HeaderContractNo to column C .Cells(row, 4).Value = Mid(Line, 30, 10) .Cells(row, 5).Value = Mid(Line, 40, 1) .Cells(row, 6).Value = Mid(Line, 41, 8) .Cells(row, 7).Value = Mid(Line, 49, 19) .Cells(row, 8).Value = Mid(Line, 68, 1) .Cells(row, 9).Value = Mid(Line, 69, 17) .Cells(row, 10).Value = Mid(Line, 86, 10) .Cells(row, 11).Value = Mid(Line, 96, 40) .Cells(row, 12).Value = Mid(Line, 136, 40) .Cells(row, 13).Value = Mid(Line, 176, 3) .Cells(row, 14).Value = Mid(Line, 179, 200) .Cells(row, 15).Value = Mid(Line, 379, 1) .Cells(row, 16).Value = Mid(Line, 380, 19) .Cells(row, 17).Value = Mid(Line, 399, 5) row = row + 1 ElseIf Left(Line,1) = "T" Then Dim bT 'as Boolean If Not bT Then 'means its the first T row so set headers 'now set 'T' headers because 'D' is finished .Cells(row, 1).Value = "Record Type" .Cells(row, 2).Value = "Sequence No" .Cells(row, 3).Value = "Contract No" .Cells(row, 4).Value = "Total Record" .Cells(row, 5).Value = "Total Amount" .Cells(row, 6).Value = "Filler" 'add 1 row to paste data again row = row + 1 'set variable so code knows headers have been set bT = True End If .Cells(row, 1).Value = Mid(Line, 1, 1) .Cells(row, 2).Value = Mid(Line, 2, 9) .Cells(row, 3).Value = Mid(Line, 30, 9) .Cells(row, 4).Value = Mid(Line, 39, 17) .Cells(row, 5).Value = Mid(Line, 65, 2) .Cells(row, 6).Value = Mid(Line, 56, 354) row = row + 1 Else 'catch errors End If 'to move down the Excel row to paste for each line in the text fix Loop End With 'Save and quit objWB.Save objWB.Close objExcel.Quit