2

我正在尝试将数据从 Excel 导入 Access。都是 2010 年。一切都运行良好，直到我遇到一个包含 [text 'A' text] 的单元格。此时，Access 完全停止了 Sub。当我手动将 Excel 单元格更改为 [text A text] 或将 '' 更改为 `` 时，一切都再次完美运行。但是必须手动更改源 Excel 无法达到目的。

当一个或多个单元格包含 [ 'A' ] 时，如何导入 Excel 工作表？预先感谢您的任何帮助。

'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
4

2 回答 2

1

您可以通过将它们加倍来转义单引号。

Function EscQ(text As String)

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

End Function

用法：

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) & "');"
于 2016-08-14T18:24:30.203 回答
0

我认为使用recordset添加新记录会以某种方式让您不必担心由于特殊字符（例如单引号或双引号）而导致 SQL 语法出错。您可以尝试添加一个功能：

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
于 2016-08-14T18:23:44.027 回答