使用VBA导入具有不同分隔符的多个文本文件

时间:2018-05-10 14:40:23

标签: excel vba excel-vba

更新的代码和问题(5/9/2018 1:53 PM Eastern)

我在尝试使用两个不同的分隔符将多个数据文本文件导入固定工作表(“原始数据”)时遇到问题。我正在使用Application.GetOpenFilename来允许用户从文件夹中选择多个文本文件。这些文件包含一个以分号分隔的标题行,然后是以逗号分隔的几行数据。在单个文本文件中,此格式可以重复多次(这是一个检查日志文件,它记录并将数据附加到每个检查运行的同一文本文件中,即标题行1,一些数据行,标题行2,更多行数据,标题行3,更多行数据等。)

我已经尝试了一些基于我在StackOverflow.com上找到的其他示例来解决这个问题的方法,但我似乎无法成功地将解决方案整合在一起以提出导入单个或多个文本文件的解决方案每个文件中有两个不同的分隔符。我无法更改原始文本文件的格式或内容,因此我无法搜索并将不同的分隔符替换为单个分隔符。

以下是我使用附加的VBA代码遇到的其余问题:

导入多个文本文件时,会在打破.TextToColumns部分的文件之间插入一个空行。它还要求在导入所选的第二个文件时替换现有数据。 使用逗号和分号作为分隔符,是否有更高效或更好的方法从多个文本文件导入数据?

在本地硬盘驱动器上的固定路径中,每个新订单号都会创建一个新的子文件夹来存储.txt数据文件(即C:\ AOI_DATA64 \ SPC_DataLog \ IspnDetails \ 123456-7)。 是否有一种方法可以提示用户输入子文件夹名称(123456-7),VBA脚本将自动从该子文件夹导入所有.txt文件,而不是使用Application.GetOpenFilename?

这是我正在尝试导入的数据文件之一的截断版本。实际文件在数据行之间没有空格。我在这个例子中将它们分开,以清楚地显示文本文件中的每一行。

[StartIspn];Time=04/19/18 12:43:15;User=yeseniar;MachineID=WINDOWS-TEFJCS1;Side=T;DoubleSided;IsOnline=1;IA_Idx=1;SN_Idx=0;IT=0;SPC_Db=1;SPC_Txt=1;TxtFmt=10;E_Rpt=1;D_Img=1;FeedMode=0;

KC17390053F,VIA5F,M North,A8,85.0,45.0,96.0,23.2,9.9,0.0,0.0,0.0,59.0,0.0,0.0,0.0,

KC17390053F,VIA3F,M North,A8,85.0,45.0,96.0,22.3,22.9,0.0,0.0,0.0,59.0,0.0,0.0,0.0,

KC17390053F,FMI1F,S South,A13,12.3,0.0,1.0,3.5,3.5,0.0,0.0,0.0,0.0,0.0,0.0,0.0,

KC17390053F,FMI13F,S South,A13,12.3,0.0,1.0,3.5,3.5,0.0,0.0,0.0,0.0,0.0,0.0,0.0,

[StartIspn];Time=04/19/18 14:28:10;User=yeseniar;MachineID=WINDOWS-TEFJCS1;Side=B;DoubleSided;IsOnline=1;IA_Idx=1;SN_Idx=0;IT=0;SPC_Db=1;SPC_Txt=1;TxtFmt=10;E_Rpt=1;D_Img=1;FeedMode=0;

KC17390066B,VIA5B,M North,A8,70.0,50.0,92.0,-38.8,-3.7,0.0,0.0,0.0,50.0,0.0,0.0,0.0,

KC17390066B,VIA6B,M North,A8,70.0,50.0,93.0,-37.7,-23.6,0.0,0.0,0.0,50.0,0.0,0.0,0.0,

KC17390066B,FMI12B,S South,A13,4140.4,0.0,2.0,3.5,129.6,0.0,0.0,0.0,0.0,0.0,0.0,0.0,

KC17390066B,FMI24B,S South,A13,2128.7,0.0,2.0,3.5,119.1,0.0,0.0,0.0,0.0,0.0,0.0,0.0,

以下是我目前导入多个文本文件的内容:

Sub Import_DataFile()

' Add an error handler
On Error GoTo ErrorHandler

' Speed up this sub-routine by turning off screen updating and auto calculating until the end of the sub-routine
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

' Define variable names and types
Dim OpenFileName As Variant
Dim i As Long
Dim n1 As Long
Dim n2 As Long
Dim fn As Integer
Dim RawData As String
Dim rngTarget As Range
Dim rngFileList As Range
Dim TargetRow As Long
Dim FileListRow As Long
Dim dLastRow As Long
Dim destCell As Range

' Select the source folder and point list file(s) to import into worksheet
OpenFileName = Application.GetOpenFilename( _
               FileFilter:="AOI Inspection Results Data Files (*.txt), *.txt", _
               Title:="Select a data file or files to import", _
               MultiSelect:=True)

' Import user selected file(s) to "Raw Data" worksheet
TargetRow = 0
Set destCell = Worksheets("Raw Data").Range("B1")
For n2 = LBound(OpenFileName) To UBound(OpenFileName)
    fn = FreeFile
    Open OpenFileName(n2) For Input As #fn
    Application.StatusBar = "Processing ... " & OpenFileName(n2)

    Do While Not EOF(fn)
        Line Input #fn, RawData
        TargetRow = TargetRow + 1
        Worksheets("Raw Data").Range("B" & TargetRow).Formula = RawData

    Loop

    Next n2

    Close #fn

 Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlDown).Address)

   With rngTarget

    .TextToColumns Destination:=destCell, DataType:=xlDelimited, _
     TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
     Semicolon:=True, Comma:=True, Space:=False, Other:=False, OtherChar:="|", _
     FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

    End With

    Else: MsgBox "The selected file is not the correct format for importing data."

    Exit Sub

    End If

Next

' Create a number list (autofill) in Col A to maintain original import sort order
dLastRow = Worksheets("Raw Data").Cells(Rows.Count, "B").End(xlUp).Row
Worksheets("Raw Data").Range("A1:A" & dLastRow).Font.Color = RGB(200, 200, 200)
Worksheets("Raw Data").Range("A1") = "1"
Worksheets("Raw Data").Range("A2") = "2"
Worksheets("Raw Data").Range("A1:A2").AutoFill Destination:=Worksheets("Raw Data").Range("A1:A" & dLastRow), Type:=xlFillDefault
Worksheets("Raw Data").Range("F1:Q" & dLastRow).NumberFormat = "0.0"

' Auto fit the width of columns for RAW Data
Worksheets("Raw Data").Columns("A:Z").EntireColumn.AutoFit

' Turn screen updating and auto calculating back on since file processing is now complete
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

' Reset to defaults in the event of a processing error during the sub-routine execution
ErrorHandler:
Application.StatusBar = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
If Err.Number <> 0 Then

' Display a message to the user including the error code in the event of an error during execution
MsgBox "An error number " & Err.Number & " was encountered!" & vbNewLine & _
       "Part or all of this VBA script was not completed.", vbInformation, "Error Message"
End If

End Sub

0 个答案:

没有答案