如何仅针对出错的文件获取错误

Question

在我的公司，我们每个月需要将大量文本文件转换为 excel，并且我们需要更改一些列的数据类型。 他们过去常常手动转换所有这些，这非常耗时。 我创建了一个访问程序，他们可以更轻松地做到这一点。 他们只需按下一个按钮，它就会传输它们，并显示所有已转换文件的运行列表。 有些文件会在这里和那里发生变化，所以当运行程序时，我有另一个列表应该显示所有导致错误的文件。 不幸的是，目前它所做的是，一旦它从一个文件收到错误——之后的每个文件也都说有错误。 所以如果有 100 个文件 witch 文件 5 和 25 作为错误，它仍然会显示从 5 到 100 的所有文件都是错误的。 这是我正在使用的代码：

    Public Sub ImportTextFile(ByVal xl As Excel.Application, ByVal strFileName As String, ByVal iNumOfCols As Integer, Optional aDataTypes As Variant = Nothing)

    On Error GoTo Sub_Err
    Dim sPathAndFile As String: sPathAndFile = cPath & strFileName
    Dim wb As Workbook: Set wb = xl.Workbooks.Add
    Dim ws As Worksheet: Set ws = wb.Sheets(1)
    With ws.QueryTables.Add(Connection:="TEXT;" & sPathAndFile & ".txt", Destination:=ws.Range("$A$1"))
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = GetColumnDataTypes(iNumOfCols, aDataTypes)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Call SaveFile(wb, sPathAndFile)
    
    Forms("Dashboard").lbCompleted.AddItem strFileName
    Forms("Dashboard").lbCompleted.Selected(Forms("Dashboard").lbCompleted.ListCount - 1) = True
    
Sub_End:
    Set wb = Nothing
    Set ws = Nothing
    Err.Clear
    Exit Sub
Sub_Err:
    'MsgBox Err.Description
    Forms("Dashboard").lbError.AddItem strFileName
    Resume Sub_End
    
End Sub

然后每个文件像这样回调：

Call ImportTextFile(xl, "DGXC094P", 11)
Call ImportTextFile(xl, "DGAC081", 18, Array(, , , , , , , , , , , , , , , , , , 2))

我尝试清除错误，但没有清除。 我究竟做错了什么？ 我怎样才能让它只显示有错误的文件？

Answer 1

关于导入Textfile的Sub：把它设为function。然后你可以回调是否有错误。 像这样：

Public Function ImportTextFile(ByVal xl As Excel.Application, ByVal strFileName As String, ByVal iNumOfCols As Integer, Optional aDataTypes As Variant = Nothing) as boolean

On Error GoTo ErrorHandling
Dim sPathAndFile As String: sPathAndFile = cPath & strFileName
Dim wb As Workbook: Set wb = xl.Workbooks.Add
Dim ws As Worksheet: Set ws = wb.Sheets(1)
With ws.QueryTables.Add(Connection:="TEXT;" & sPathAndFile & ".txt", Destination:=ws.Range("$A$1"))
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SaveData = True
    .AdjustColumnWidth = False
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 437
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = True
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = GetColumnDataTypes(iNumOfCols, aDataTypes)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
Call SaveFile(wb, sPathAndFile)

Forms("Dashboard").lbCompleted.AddItem strFileName
Forms("Dashboard").lbCompleted.Selected(Forms("Dashboard").lbCompleted.ListCount - 1) = True

Set wb = Nothing
Set ws = Nothing
ImportTextFile = true
Exit Function

ErrorHandling:
Set wb = Nothing
Set ws = Nothing
ImportTextFile = false

End Function

调用 function 的过程应如下所示：

Dim ImportResult as boolean

ImportResult = ImportTextFile(xl, "DGAC081", 18, Array(, , , , , , , , , , , , , , , , , , 2))

'Case Import Error
If ImportResult = false then
    Forms("Dashboard").lbError.AddItem strFileName
end if

'Case Import OK
If ImportResult = true then
    'What you want
end if

当使用 function 而不是 sub 时，您将能够单独处理每个导入。