Reputation: 21
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
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
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