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

【问题标题】：Using VBA to Import multiple text files with different delimiters使用 VBA 导入具有不同分隔符的多个文本文件
【发布时间】：2018-05-10 14:40:22
【问题描述】：

更新的代码和问题（2018 年 5 月 9 日东部时间下午 1:53）

我在尝试使用两个不同的分隔符将多个数据文本文件导入固定工作表（“原始数据”）时遇到问题。我正在使用 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

【问题讨论】：

您从错误处理开始您的子程序，但很快就建立了On Error Resume Next（实际上是两次），并且永远不会恢复到On Error GoTo 0。在这些条件下，您将很难调试它。
@dwirony 对错误视而不见要比处理错误容易得多。
@dwirony 我在运行模块时禁用了 On Error 行。如果用户的 PC 上不存在网络路径或文件夹路径，则需要 On Error Resume Next 实例以避免因错误条件而停止。
@Andreas 我没有闭上眼睛以避免处理错误。添加 On Error 行是为了避免当用户的 PC 无法访问我定义为默认目录的某些文件路径时出现故障，但使他们能够手动查找文件。
@JRN0504 对，这很好，但是一旦他们选择了文件，您需要通过重新实现 On Error GoTo ErrorHandler 行来重新打开错误处理

标签： vba excel

【解决方案1】：

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

提示用户输入工作目录：

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

将文件收集到缓冲区

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

减少分隔符的数量：只需使用替换
```
RawData = Replace(RawData, ";", ",")
```
对于空行我不知道，虽然它可能是源文件中空行的结果，也许是 EOF。那么如果在复制之前检查该行怎么办：
```
If len(trim(RawData)) > 0 Then 
    TargetRow = TargetRow + 1
    Worksheets("Raw Data").Range("B" & TargetRow) = RawData
End If
```

请注意，我已删除 .Formula。您正在处理价值观。

设置目标范围：你应该省略.Address。要选择范围中的最后一个单元格，您应该这样使用.End(xlUp)：
```
Set rngTarget = Worksheets("Raw Data").Range("B1" & ":" & Worksheets("Raw Data").Range("B1").End(xlUp))
```

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

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

祝你好运！

【讨论】：