How to avoid importing errors from formulas in Excel with Access

Question

I have a series of identically formatted spreadsheets that I need to import into an access db. Unfortunately the spreadsheet data isn't in tabular form so I need to import a bunch of specific cells.

I read specific cells into variables and construct a query to insert rows into a table.

The code fails, when a cell contains a formula that equates to an error. To avoid the error, I must insert Null instead of the error value. How do I insert Null instead of the error value?

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

It is a good idea to trim down the source code you post to stackoverflow. It makes it easier to for people to help you. — GoWiser
– GoWiser, Commented Aug 31, 2021 at 13:27
Do this to avoid bugs that are hard to find: Don't put parenthesis's around the arguments to methods, when the return value isn't assigned to something. And try to avoid nesting With statements - i.e. in this case assign the workbook to a variable. — GoWiser
– GoWiser, Commented Aug 31, 2021 at 16:03
Your example will always only insert one row, because the DoCmd.RunSQL is outside the loop. — GoWiser
– GoWiser, Commented Aug 31, 2021 at 16:07
yes, sorry that's a mistake, i moved the Wend when i was troubleshooting. — kiwibyron
– kiwibyron, Commented Sep 1, 2021 at 4:35
One more thing. This declares A as Variant and B as Long "Dim A, B As Long". You must specify the type for each variable, if you want both of them to be longs ""Dim A As Long, B As Long". — GoWiser
– GoWiser, Commented Sep 1, 2021 at 11:51

GoWiser · Accepted Answer · 2021-09-01 03:39:34Z

1

Declare the variables as Variant to be able to assign Null to them. Then instead of quoting the values, when constructing the select statement, quote them before constructing it:

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 & "'")

A better solution is to use Access's build-in functionality for creating new records, to avoid constructing a malformed query string:

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

We do not need to quote our values or the like, when inserting them this way.

Here is a stripped down version of how to do fix the the source code. It shows not only how to use .RunSQL, but also .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

I recommend that you read a single range from the sheet, containing all the cells you need into an array, instead of referring to the sheet multiple times. See:

Speed up VBA using an array

edited Sep 1, 2021 at 3:39

answered Aug 31, 2021 at 10:03

GoWiser

1,1049 silver badges24 bronze badges

Sign up to request clarification or add additional context in comments.

9 Comments

kiwibyron Over a year ago

Thanks @Gowiser but i'm getting the same type mismatch error to my original code. When i hover over myvar in debug mode it shows myvar = Error 2007. This is happening for variables of cells where a #DIV/0! error is present in the spreadsheet. I also don't want to make cells that = 0 into null, just the error cells.

GoWiser Over a year ago

I updated the answer to include a working version. Please report back if it works for you.

kiwibyron Over a year ago

Thanks @Gowiser, the error is gone and the code executes fine, however now it inserts 2007 into the fields where errors are present in the cells. i suppose i could add a catch for this but i'm wondering if a tweak somewhere would fix it?

GoWiser Over a year ago

The ImportCell() function should handle errors produced by formulas. If error messages occurs in cells, but the cell value is not of type "Error", then you have to check the cell value against them, e.g. "Error 2007" or "Error" or the like - but this will prevent you from importing strings with the same values. I.e. If TypeName(myvar) = "Error" Or myvar = "Error 2007" Or myvar = "Error" ... etc. The type of the values returned by failed formulas from Excel are always "Error". I would be interested in seeing an example that proves me wrong.

kiwibyron Over a year ago

Thanks again @Gowiser, I managed to get it to work as required by adding Or CStr(myval) = "Error 2007" Or CStr(myval) = "" to the If statement in the ImportCell() function. I tried without the CStr() but it threw me back to square one. The CStr(myval) = "" is catching blank cells the function is converting to 0 for numeric fields which i can't have. i've looped through a couple of times and it doesn't appear to be resulting in "Error", it's always "Error 2007". I wonder if this is because the spreadsheets were built pre 2003?

|

Collectives™ on Stack Overflow

How to avoid importing errors from formulas in Excel with Access

1 Answer 1

9 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

9 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related