MrJCob
MrJCob

Reputation: 21

VBA import excel into access glitches when excel cell contains double ' '

I am trying to import data from Excel into Access. Both 2010. Everything worked perfectly until I came across a cell that contained [text 'A' text]. Access completely stops the Sub at this point. When I manually change the Excel cell to [text A text] or the '' to ``, everything works perfectly again. But having to manually changing the source Excel defeats the purpose.

How do I import an Excel sheet when one or more cells contain [ 'A' ]? Thank you in advance for any help.

'This checks if file exsist, imports file, then imports any sequential files. 
Option Explicit
Public Sub ImportXL2(bolJustExcelFile As Boolean, Optional bolRefresh As Boolean)

            Dim rstXL As DAO.Recordset
            Dim x As Integer, y As Long
            Dim strPath1 As String, strPath2 As String
            Dim strPN As String, strDescription As String, strPrime As String
            Dim intOHB As Integer, sngCost As Single, intMin As Integer, intMax As Integer
            Dim strCode As Integer, strNumber As String, strDate As String, strQty As Integer, strRepairable As String, strEntity As String

            DoCmd.SetWarnings False
            DoCmd.RunSQL "DELETE FROM ExcelFile"

            If bolJustExcelFile = False Then
                DoCmd.RunSQL "DELETE FROM ExcelFileCombined"
            End If

            For x = 1 To 10

            DoCmd.RunSQL "DELETE FROM ExcelFiletemp"

            strPath1 = Environ("userprofile") & "\Desktop\Folder\ExcelFile.xlsx"
            strPath2 = Environ("userprofile") & "\Desktop\Folder\ExcelFile" & x & ".xlsx"

                If x = 1 Then
                    If FileExists(strPath1) = -1 Then
                        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "ExcelFiletemp", strPath1, False, "A:L"

                        Else
                        If bolRefresh = True Then
                            MsgBox "ExcelFile File Not Found", , "Missing ExcelFile File"
                        End If

                        Exit For
                    End If
                Else
                    If FileExists(strPath2) = -1 And bolJustExcelFile = False Then
                        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "ExcelFiletemp", strPath2, False, "A:L"
                    Else
                        GoTo SkipXL
                    End If
                End If

                Set rstXL = CurrentDb.OpenRecordset("SELECT * FROM ExcelFiletemp", dbOpenSnapshot)

                rstXL.MoveLast
                rstXL.MoveFirst

                    For y = 1 To 4
                        rstXL.MoveNext
                    Next y

                strEntity = Right(rstXL![F1], 6)

                    For y = 1 To 4
                        rstXL.MoveNext
                    Next y
            On Error GoTo ErrHandler

                    For y = 1 To rstXL.RecordCount - 8

                            strPN = rstXL![F1]
                            strDescription = rstXL![F2]
                            strPrime = rstXL![F3]
                            intOHB = rstXL![F4]
                            sngCost = rstXL![F5]
                            intMin = rstXL![F6]
                            intMax = rstXL![F7]
                            strCode = rstXL![F8]
                            strRepairable = rstXL![F12]

                            If x = 1 Then
                                DoCmd.RunSQL "INSERT INTO ExcelFile (PN, Description, Prime, OHB, Cost, Min, Max, Code, Repairable, Entity) VALUES ('" & strPN & "','" & strDescription & "','" & strPrime & "'," & intOHB & "," & sngCost & "," & intMin & "," & intMax & "," & strCode & ",'" & strRepairable & "','" & strEntity & "');"
                            End If

                            If bolJustExcelFile = False Then
                                DoCmd.RunSQL "INSERT INTO ExcelFileCombined (PN, Description, Prime, OHB, Cost, Min, Max, Code, Repairable, Entity) VALUES ('" & strPN & "','" & strDescription & "','" & strPrime & "'," & intOHB & "," & sngCost & "," & intMin & "," & intMax & "," & strCode & ",'" & strRepairable & "','" & strEntity & "');"
                            End If
                    rstXL.MoveNext
                    Next y
                rstXL.Close
SkipXL:
                Next x

            Set rstXL = Nothing

            DoCmd.SetWarnings True
ErrHandler:
                    If Err.Number = 94 Then 'Invalid use of Null

                    rstXL.MoveNext
                    End If

            End Sub

Upvotes: 2

Views: 165

Answers (2)

user6432984
user6432984

Reputation:

You can escape single quotes by doubling them up.

Function EscQ(text As String)

    EscQ = Replace(text, "'", "''")

End Function

Usage:


DoCmd.RunSQL "INSERT INTO ExcelFileCombined (PN, Description, Prime, OHB, Cost, Min, Max, Code, Repairable, Entity) VALUES ('" & EscQ(strPN) & "','" & EscQ(strDescription) & "','" & EscQ(strPrime) & "'," & intOHB & "," & sngCost & "," & intMin & "," & intMax & "," & strCode & ",'" & EscQ(strRepairable) & "','" & EscQ(strEntity) & "');"

Upvotes: 1

winghei
winghei

Reputation: 652

I think using recordset to add new record will somehow make you worry free about SQL Syntax getting wrong because of special characters e.g. single or double quotes. You can try add a function:

Function insrt_item(rstXL as DAO.Recordset, tbl_dest as String) ' set tbl_dest   to ExcelFile or ExcelFileCombined  since they are same fields anyway
     With currentdb.OpenRecordSet(tbl_dest)
       .AddNew
       !PN = rstXL!F1
       !Description = rstXL!F2
        '.. add more fields here
       .Update
       .Close 
    End With
End Function 

Upvotes: 0

Related Questions