使用VBA导入具有不同定界符的多个文本文件 [英] Using VBA to Import multiple text files with different delimiters

问题描述

更新的代码和问题(2018年5月9日东部时间1:53 PM)

UPDATED CODE AND ISSUES (5/9/2018 1:53PM Eastern)

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

I am encountering problems trying to import multiple data text files into a fixed worksheet ("Raw Data") using two different delimiters. I am using Application.GetOpenFilename to allow the user to select multiple text files from a folder. The files contain a header row which is semicolon delimited, then several lines of data which is comma delimited. In a single text file, this format can be repeated several times (this is an inspection log file which records and appends data to the same text file for each inspection run, i.e. header line1, some rows of data, header line 2, more rows of data, header line 3, more rows of data, etc.)

根据在StackOverflow.com上发现的其他示例，我尝试了几种方法来解决此问题，但是我似乎无法成功地将解决方案网格化，从而无法得出导入单个或多个文本文件的解决方案每个文件中都有两个不同的定界符.我无法更改原始文本文件的格式或内容，因此无法搜索并将不同的定界符替换为单个定界符.

I've tried a few approaches to solve this based on other examples I've found on StackOverflow.com but I can't seem to successfully mesh the solutions together to come up with a solution that imports single or multiple text files with two different delimiters within each file. I cannot change the format or content of the original text files, so I can't search and replace different delimiters to a single delimiter.

以下是我在随附的VBA代码中遇到的其余问题:

Here are the remaining issues I'm running into with the attached VBA code:

当导入多个文本文件时，在文件之间插入一个空行，该行将中断.TextToColumns部分.在导入所选的第二个文件时，它还要求替换现有数据.是否存在使用逗号和分号作为分隔符从多个文本文件导入数据的更有效或更完善的方法?

When importing more than one text file, a blank line is inserted between the files which breaks the .TextToColumns section. It is also asking to replace existing data when importing the second file selected. Is there a more efficient or better way to import data from multiple text files using both commas and semicolons as delimiters?

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

Within a fixed path on the local hard drive, each new order number creates a new sub-folder to store .txt data files (i.e. C:\AOI_DATA64\SPC_DataLog\IspnDetails\123456-7). Is there a way the user can be prompted to enter a sub-folder name (123456-7) and the VBA script will automatically import all .txt files from this sub-folder, rather than using Application.GetOpenFilename?

这是我要导入的数据文件之一的截断版本.实际文件在数据行之间没有空格.在本示例中，我将它们分开以清楚地显示文本文件中的每一行.

Here is a truncated version of one of the data files I'm trying to import. The actual file does not have spaces between the rows of data. I separated them in this example to clearly show each line in the text file.

[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,

到目前为止，这是我导入多个文本文件的目的:

Here is what I have so far for importing multiple text files:

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

推荐答案

许多问题...让我给出一些提示.

Many questions... Let me give some hints.

1. 提示用户输入工作目录:

1. Prompting the user for working directory :

Dim fDlg As FileDialog      ' dialog box object
Dim sDir As String          ' selected path
Dim iretval As Long         ' test

Set fDlg = Application.FileDialog(msoFileDialogFolderPicker)
sDir = conDEFAULTPATH   ' init
With fDlg
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = sDir
    iretval = .Show
    If iretval = -1 Then sDir = .SelectedItems(1)
End With
Set fDlg = Nothing              ' drop object

If sDir = vbNullString Then
     MsgBox "Invalid directory"
Else
     If Right$(Trim$(sDir), 1) <> Application.PathSeparator Then _
          sDir = Trim$(sDir) & Application.PathSeparator' append closing backslash to pathname
End If

将文件收集到缓冲区

Collecting files to a buffer

Dim FileBuf(100) as string, FileCnt as long
FileCnt=0
FileBuf(FileCnt)=Dir(sDir & "*.txt")
Do While FileBuf(FileCnt) <> vbnullstring
       FileCnt = FileCnt + 1
       FileBUf(FileCnt) = Dir
Loop

减少定界符的数量:只需使用replace

Reducing number of delimiters: simply use replace

RawData = Replace(RawData, ";", ",")

对于空白行，我毫无头绪，尽管这可能是源文件中空白行(可能是EOF)的结果.那么，如果您在复制前检查该行怎么办:

For the blank line I have no clue, though it might be a result of a blank line in the source file, maybe the EOF. So what if you check the line before copying:

If len(trim(RawData)) > 0 Then 
    TargetRow = TargetRow + 1
    Worksheets("Raw Data").Range("B" & TargetRow) = RawData
End If

请注意，我已经删除了 .Formula .您正在使用价值观.

Please note that I've removed .Formula. You are working with values.

1. 用于设置目标范围:您应省略 .Address .要选择范围中的最后一个单元格，应使用 .End(xlUp)这样:

1. For setting target range: You should omit .Address. For selecting last cell in a range, you should use .End(xlUp) this way:

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

我更喜欢使用直接单元格引用，所以-正如您确切地知道最后一行-我会这样:

I prefer using direct cell references, so - as you exactly know the last row - I would do it this way:

Set rngTarget =  Worksheets("Raw Data").Range(Cells(1, 2), Cells(TargetRow, 2))

祝你好运！

这篇关于使用VBA导入具有不同定界符的多个文本文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！