如何使用 Access 避免从 Excel 中的公式导入错误答案

【问题标题】：How to avoid importing errors from formulas in Excel with Access如何使用 Access 避免从 Excel 中的公式导入错误
【发布时间】：2021-08-31 09:46:54
【问题描述】：

我有一系列格式相同的电子表格，我需要将它们导入访问数据库。不幸的是，电子表格数据不是表格形式，所以我需要导入一堆特定的单元格。

我将特定单元格读入变量并构造一个查询以将行插入表中。

当单元格包含等于错误的公式时，代码将失败。为了避免错误，我必须插入 Null 而不是错误值。如何插入 Null 而不是错误值？

Public Function ImportSheet()
    Dim xl As Object
    Dim jobno, Address, PM As String
    Dim EDate As Date
    Dim SID As String, SM, SDepth, SCon As String
    Dim SDate As Date
    Dim Sby, SDesc, Tby, Inc, Crack, Crumb As String
    Dim AD1, AD2, AD3, AL1, AL2, AL3 As Double
    Dim SHCID As String
    Dim SHCMass, ILength, IDiam, M0, M1, M2, M3, M4, M5, L0, L1, L2, L3, L4, L5, MC0, MC1, MC2, MC3, MC4, MC5 As Double
    Dim ST0, ST1, ST2, ST3, ST4, ST5, SW0, SW10, SW30, SW1h, SW21h, SW24h, SWih, Esw As Double
    Dim BSWCID As String
    Dim BCMass, BIM, BFM As Double
    Dim ASWCID As String
    Dim ACMass, AIM, AFM, MCI, MCISw, MCFSw, SFS, WD, DD, ISS As Double
        
    Set xl = CreateObject("Excel.Application")
        
    Dim xfileName As Variant
    xfileName = Dir("C:\Users\username\Desktop\Database\Sheets\*.xls")
    
    DoCmd.SetWarnings (False)
    On Error Resume Next
    
    While xfileName <> ""
        With xl.Workbooks.Open(fileName:="C:\Users\username\Desktop\Database\Sheets\" & xfileName)
            With .Sheets("Working Sheet")
                jobno = .Cells(3, "G").Value
                Address = .Cells(3, "C").Value
                PM = .Cells(2, "G").Value
                EDate = .Cells(4, "C").Value
                SID = .Cells(5, "C").Value
                SM = .Cells(6, "C").Value
                SDepth = .Cells(7, "C").Value
                SCon = .Cells(8, "C").Value
                SDate = .Cells(5, "G").Value
                Sby = .Cells(6, "G").Value
                SDesc = .Cells(10, "C").Value
                Tby = .Cells(4, "G").Value
                Inc = .Cells(7, "G").Value
                Crack = .Cells(8, "G").Value
                Crumb = .Cells(9, "G").Value
                AD1 = .Cells(13, "C").Value
                AD2 = .Cells(14, "C").Value
                AD3 = .Cells(15, "C").Value
                AL1 = .Cells(13, "D").Value
                AL2 = .Cells(14, "D").Value
                AL3 = .Cells(15, "D").Value
                SHCID = .Cells(12, "G").Value
                SHCMass = .Cells(13, "G").Value
                ILength = .Cells(14, "G").Value
                IDiam = .Cells(15, "G").Value
                M0 = .Cells(19, "C").Value
                M1 = .Cells(20, "C").Value
                M2 = .Cells(21, "C").Value
                M3 = .Cells(22, "C").Value
                M4 = .Cells(23, "C").Value
                M5 = .Cells(24, "C").Value
                L0 = .Cells(19, "D").Value
                L1 = .Cells(20, "D").Value
                L2 = .Cells(21, "D").Value
                L3 = .Cells(22, "D").Value
                L4 = .Cells(23, "D").Value
                L5 = .Cells(24, "D").Value
                MC0 = .Cells(19, "E").Value
                MC1 = .Cells(20, "E").Value
                MC2 = .Cells(21, "E").Value
                MC3 = .Cells(22, "E").Value
                MC4 = .Cells(23, "E").Value
                MC5 = .Cells(24, "E").Value
                ST0 = .Cells(19, "F").Value
                ST1 = .Cells(20, "F").Value
                ST2 = .Cells(21, "F").Value
                ST3 = .Cells(22, "F").Value
                ST4 = .Cells(23, "F").Value
                ST5 = .Cells(24, "F").Value
                SW0 = .Cells(29, "B").Value
                SW10 = .Cells(30, "B").Value
                SW30 = .Cells(31, "B").Value
                SW1h = .Cells(32, "B").Value
                SW21h = .Cells(33, "B").Value
                SW24h = .Cells(34, "B").Value
                SWih = .Cells(28, "G").Value
                Esw = .Cells(34, "G").Value
                BSWCID = .Cells(43, "F").Value
                BCMass = .Cells(44, "F").Value
                BIM = .Cells(45, "F").Value
                BFM = .Cells(46, "F").Value
                ASWCID = .Cells(43, "G").Value
                ACMass = .Cells(44, "G").Value
                AIM = .Cells(45, "G").Value
                AFM = .Cells(46, "G").Value
                MCI = .Cells(50, "D").Value
                MCISw = .Cells(51, "D").Value
                MCFSw = .Cells(52, "D").Value
                SFS = Abs(.Cells(52, "E").Value)
                WD = .Cells(53, "G").Value
                DD = .Cells(54, "G").Value
                ISS = .Cells(56, "G").Value
                xl.Workbooks(xfileName).Close SaveChanges:=False
            End With
        End With
        On Error GoTo 0
        xfileName = Dir
    Wend
    xfileName = ""
    Set xl = Nothing
    DoCmd.SetWarnings (True)
    
    Dim SQL As String
    SQL = "INSERT INTO Results ( JobNo, Address, PM, EDate, SID, SM, SDepth, SCon, SDate, SBy, SDesc, TBy, Inc, Crack, Crumb, " _
        & "AD1, AD2, AD3, AL1, AL2, AL3, SHCID, SHCMass, ILength, IDiam, M0, M1, M2, M3, M4, M5, L0, " _
        & "L1, L2, L3, L4, L5, MC0, MC1, MC2, MC3, MC4, MC5, ST0, ST1, ST2, ST3, ST4, ST5, SW0, SW10, SW30, SW1h, SW21h, " _
        & "SW24h, SWih, Esw, BSWCID, BCMass, BIM, BFM, ASWCID, ACMass, AIM, AFM, MCI, MCISw, MCFSw, SFS, WD, DD, Iss ) " _
        & "SELECT '" & jobno & "', '" & Address & "', '" & PM & "', #" & EDate & "#, '" & SID & "', '" & SM & "', '" & SDepth & "', '" & SCon & "', #" & SDate & "#, " _
        & "'" & Sby & "', '" & SDesc & "', '" & Tby & "', '" & Inc & "', '" & Crack & "', '" & Crumb & "', '" & AD1 & "', " _
        & "'" & AD2 & "', '" & AD3 & "', '" & AL1 & "', '" & AL2 & "', '" & AL3 & "', '" & SHCID & "', '" & SHCMass & "', " _
        & "'" & ILength & "', '" & IDiam & "', '" & M0 & "', '" & M1 & "', '" & M2 & "', '" & M3 & "', '" & M4 & "', " _
        & "'" & M5 & "', '" & L0 & "', '" & L1 & "', '" & L2 & "', '" & L3 & "', '" & L4 & "', '" & L5 & "', '" & MC0 & "', " _
        & "'" & MC1 & "', '" & MC2 & "', '" & MC3 & "', '" & MC4 & "', '" & MC5 & "', '" & ST0 & "', '" & ST1 & "', '" & ST2 & "', '" & ST3 & "', " _
        & "'" & ST4 & "', '" & ST5 & "', '" & SW0 & "', '" & SW10 & "', '" & SW30 & "', '" & SW1h & "', '" & SW21h & "', " _
        & "'" & SW24h & "', '" & SWih & "', '" & Esw & "',  '" & BSWCID & "', '" & BCMass & "', " _
        & "'" & BIM & "', '" & BFM & "', '" & ASWCID & "', '" & ACMass & "', '" & AIM & "', '" & AFM & "', '" & MCI & "', " _
        & "'" & MCISw & "', '" & MCFSw & "', '" & SFS & "', '" & WD & "', '" & DD & "', '" & ISS & "'"
    
    DoCmd.RunSQL SQL
    MsgBox "Done"
End Function

【问题讨论】：

精简发布到 stackoverflow 的源代码是个好主意。它使人们更容易帮助您。
这样做是为了避免难以发现的错误：当返回值未分配给某物时，不要将括号放在方法的参数周围。并尽量避免嵌套 With 语句 - 即在这种情况下将工作簿分配给一个变量。
您的示例将始终只插入一行，因为 DoCmd.RunSQL 在循环之外。
是的，抱歉打错了，我在进行故障排除时移动了 Wend。
还有一件事。这将 A 声明为 Variant，B 声明为 Long “Dim A, B As Long”。如果您希望它们都是 longs ""Dim A As Long, B As Long"，则必须为每个变量指定类型。

标签： excel import

【解决方案1】：

将变量声明为 Variant 以便能够将 Null 分配给它们。然后在构造 select 语句时，不要引用值，而是在构造它之前引用它们：

Dim myvar as Variant
myvar = .Cells(x, y).Value
' We should make sure myvar don't contain apostrophes
myvar = IIf(TypeName(myvar) = "Error", "Null", "'" & myvar & "'")

更好的解决方案是使用 Access 的内置功能来创建新记录，以避免构造格式错误的查询字符串：

Dim myvar As Variant
Dim db As DAO.Database
Dim rs As DAO.Recordset
    ...
Set db = CurrentDb
Set rs = db.OpenRecordset("tablename")
With rs
    .AddNew
    ![FieldName] = IIf(TypeName(myvar) = "Error", Null, myvar)
       ...
    .Update
End With

以这种方式插入它们时，我们不需要引用我们的值等。

这里是如何修复源代码的精简版。它不仅展示了如何使用 .RunSQL，还展示了 .AddNew。

Option Explicit
Option Compare Database

Public Function ImportCell(myval As Variant)
    If TypeName(myval) = "Error" Then
        ImportCell = Null
    Else
        ImportCell = myval
    End If
End Function

Public Function ToSqlString(myval As Variant) As Variant
    Dim tmp As Variant
    
    tmp = ImportCell(myval)
    If IsNull(tmp) Then
        ToSqlString = "Null"
    Else
        ToSqlString = "'" & myval & "'"
    End If
End Function

Public Function ToSqlDate(myval As Variant) As Variant
    Dim tmp As Variant
    Dim dat As Variant

    tmp = ImportCell(myval)
    If IsNull(tmp) Then
        ToSqlDate = "Null"
        Exit Function
    End If
    On Error Resume Next
    dat = CDate(myval)
    dat = "#" & Format(dat, "yyyy-mm-dd") & "#"
    If Err.Number <> 0 Then
        ToSqlDate = "Null"
        Err.Clear
        Exit Function
    End If
    ToSqlDate = dat
End Function

Public Function ToSqlDouble(myval As Variant) As Variant
    Dim tmp As Variant
    Dim dbl As Double
    
    tmp = ImportCell(myval)
    If IsNull(tmp) Then
        ToSqlDouble = "Null"
        Exit Function
    End If
    On Error Resume Next
    dbl = CDbl(myval)
    If Err.Number <> 0 Then
        ToSqlDouble = "Null"
        Err.Clear
        Exit Function
    End If
    ToSqlDouble = dbl
End Function

Public Sub ImportSheet()
    Dim path As String
    Dim filename As Variant
    Dim app As Object
    Dim wbk As Object
    Dim sht As Object
    Dim JobNo As Variant ' String
    Dim SDate As Variant ' Date
    Dim M1 As Variant ' Double
    Dim query As String
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Results")

    Set app = CreateObject("Excel.Application")
    path = "C:\Users\username\Desktop\Database\Sheets\"
    filename = Dir(path & "*.xls")
    DoCmd.SetWarnings False
    app.Visible = True
    While filename <> ""
        ' Get row data from the workbook
        Set wbk = app.Workbooks.Open(filename:=path & filename)
        Set sht = wbk.Sheets("Working Sheet")
        ' Debugging data: sht.Range(sht.cells(1, 1), sht.cells(100, 100)) = "=ROW() & ""x"" & COLUMN()"
        If False Then
            ' Use DoCmd.RunSQL
            JobNo = ToSqlString(sht.cells(3, 5)) ' string
            SDate = ToSqlDate(sht.cells(5, 5)) ' date
            M1 = ToSqlDouble(sht.cells(20, 3)) ' double
            ' Insert the row into the table
            query = "INSERT INTO Results ( JobNo, SDate, M1 ) " & _
                    "SELECT " & JobNo & ", " & SDate & ", " & M1 & " "
            'Debug.Print query
            DoCmd.RunSQL query
        Else
            ' Use RecordSet.AddNew
            With rs
                .AddNew
                ' The excel cells must contain the expected  type of data.
                ' The type can be checked, using a technique similar (but simpler) to the ones used by the ToSqlXXXX-methods
                ![JobNo] = ImportCell(sht.cells(3, 5))
                ![SDate] = ImportCell(sht.cells(5, 5))
                ![M1] = ImportCell(sht.cells(20, 3))
                .Update
            End With
        End If
        wbk.Close SaveChanges:=False
        ' Get the next filename
        filename = Dir
    Wend
    DoCmd.SetWarnings True
    MsgBox "Done"
End Sub

我建议您从工作表中读取一个范围，将您需要的所有单元格包含到一个数组中，而不是多次引用工作表。见：

Speed up VBA using an array

【讨论】：

感谢@Gowiser，但我的原始代码遇到了相同的类型不匹配错误。当我在调试模式下将鼠标悬停在 myvar 上时，它显示 myvar = 错误 2007。这发生在 #DIV/0！电子表格中存在错误。我也不想将 = 0 的单元格设为 null，而只是将错误单元格设为空。
我更新了答案以包含一个工作版本。如果它适合你，请报告。
感谢@Gowiser，错误消失了，代码执行得很好，但是现在它将 2007 插入到单元格中存在错误的字段中。我想我可以为此添加一个问题，但我想知道某个地方的调整是否可以解决它？
ImportCell() 函数应该处理公式产生的错误。如果单元格中出现错误消息，但单元格值不是“错误”类型，那么您必须对照它们检查单元格值，例如“Error 2007”或“Error”等 - 但这会阻止您导入具有相同值的字符串。 IE。如果 TypeName(myvar) = "Error" 或 myvar = "Error 2007" 或 myvar = "Error" ... 等。Excel 中失败公式返回的值的类型始终为“Error”。我有兴趣看到一个证明我错了的例子。
再次感谢@Gowiser，我设法通过在 ImportCell( ）功能。我尝试不使用 CStr() ，但它让我回到了第一方。 CStr(myval) = "" 正在捕获空白单元格，该函数正在将我无法拥有的数字字段转换为 0。我已经循环了几次，它似乎没有导致“错误”，它总是“错误 2007”。我想知道这是不是因为电子表格是在 2003 年之前构建的？