VBScript将.txt文件导入到.xlsx文件

时间:2019-09-12 07:47:41

标签: excel text vbscript

我使用此 VBScript 代码尝试在excel文件 output.xlsx 文本文件 input.txt

上导入

这是文本文件 input.txt

enter image description here

这是Excel文件 output.xlsx

enter image description here

此代码没有错误,但 output.xlsx 为空。

该如何解决?

ExcelFilePath = "D:\xlsx\output.xlsx"

Set objExcel = CreateObject("Excel.Application")
objExcel.visible = True
Set objWB = objExcel.Workbooks.Open(ExcelFilePath)
Set SheetObject = objWB.Worksheets("Sheet1")

TextFile = "D:\txt\input.txt"

Set TextRead = objFSO.OpenTextFile(TextFile, ForReading)

row = 2

With SheetObject
    .Cells(1, 1).Value = "CO"
    .Cells(1, 2).Value = "Sequence No"
    .Cells(1, 3).Value = "Transaction Date"
    .Cells(1, 4).Value = "Contract No"
    .Cells(1, 5).Value = "Creation Date"
    .Cells(1, 6).Value = "Source"
    .Cells(1, 7).Value = "Record"
    .Cells(1, 8).Value = "Amount"
    .Cells(1, 9).Value = "Source"
    .Cells(1, 10).Value = "Filler"

    Do Until TextRead.AtEndOfStream
        Line = TextRead.ReadLine

        .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)
        .Cells(row, 10).Value = Mid(Line, 67, 334)

        row = row + 1
    Loop
End With

objWB.Save
objWB.Close
objExcel.Quit

#Edit 01

非常感谢您的帮助,我尝试了此新代码,但没有成功。

我的脚本没有错误,但是XLSX文件为空

ExcelFilePath = "D:\xlsx\output.xlsx"

Set objExcel = CreateObject("Excel.Application")
objExcel.visible = True
Set objWB = objExcel.Workbooks.Open(ExcelFilePath)
Set SheetObject = objWB.Worksheets("Sheet1")

TextFile = "D:\txt\input.txt"

Set TextRead = objFSO.OpenTextFile(TextFile, ForReading)

row = 2

With SheetObject
    .Cells(1, 1).Value = "CO"
    .Cells(1, 2).Value = "Sequence No"
    .Cells(1, 3).Value = "Transaction Date"
    .Cells(1, 4).Value = "Contract No"
    .Cells(1, 5).Value = "Creation Date"
    .Cells(1, 6).Value = "Source"
    .Cells(1, 7).Value = "Record"
    .Cells(1, 8).Value = "Amount"
    .Cells(1, 9).Value = "Source"
    .Cells(1, 10).Value = "Filler"

    Do Until TextRead.AtEndOfStream
        Line = TextRead.ReadLine

        aLines = split(TextFile.ReadAll, vbnewline)
        For irow = 1 To UBound(aLines) + 1
            aline = split(aLines(irow-1), "|")
            For icol = 1 To UBound(aline) + 1
               SheetObject.Cells(irow, icol).value = aline(icol-1)
            Next
        Next

        row = row + 1
    Loop
End With

objWB.Save
objWB.Close
objExcel.Quit

#Edit 02

With SheetObject
    Do Until TextRead.AtEndOfStream
        strLine = Trim(TextRead.ReadLine)

        If (strLine <> "") Then
            arrValues = Split(strLine, "|")
            For irow = 1 To UBound(arrValues) + 1
                For icol = 1 To UBound(arrValues) + 1
                    SheetObject.Cells(irow, icol).value = arrValues(icol-1)
                Next
             Next
        End If
    Loop
End With

0 个答案:

没有答案