Question

我正在尝试使用＆＃34; SELECT（列,,,）INTO TEMPO FROM ...＆＃34将excel表格中的一些列（实际上包含156列x 16k行）拉入动态创建的表格中;但是，虽然代码执行，但表格不会出现在导航窗格中。有时，它会在.Execute（StrSQL）行上出现错误，表示＃34;表已存在＆＃34;。

我已经尝试检查表是否存在，然后删除它或隐藏的Sys表中，但它没有显示。正如您可以看到注释代码，我还尝试了 RefreshDatabaseWindow 以及 CurrentDb.TableDefs.Refresh ，但表格仍然没有显示。

我还尝试过 DoCmd.TransferSpreadsheet 来提取工作表数据，但结果是＆＃34;记录太大＆＃34;错误。此外，使用 DoCmd.TransferSpreadsheet ，无法选择不相邻的列。此外，在某些其他Excel工作表提取中，列的顺序可能不同。

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "TEMPO", FileSelector(), True, "Soaps$"

任何人都可以帮我修改代码吗？

    Sub grabData()

    DoCmd.SetWarnings False

    Dim db As DAO.Database
    Dim strSQL As String
    Dim objCon As Object
    Dim objRS As Object
    Dim conStr As String

'    On Error Resume Next
'    strSQL = "DROP TABLE TEMPO;"
'    DoCmd.RunSQL strSQL
'    DoCmd.DeleteObject acTable, "TEMPO"
    If IsTableExists("TEMPO") Then CurrentDb.Execute "DROP TABLE TEMPO", dbFailOnError

    Set objCon = CreateObject("ADODB.Connection")
    Set objRS = CreateObject("ADODB.Recordset")

    strSQL = "SELECT "
    strSQL = strSQL & "[GTIN],[PVID],[Version Date],[Languages on Pack],[Description],[Brand],[Features],"
    strSQL = strSQL & "[Other Information],[Trademark Information],[Safety Warnings],[Country],"
    strSQL = strSQL & "[Manufacturers Address],[Importer Address],[Return To],[Web Address],[Recycling],"
    strSQL = strSQL & "[Recycling Other Text],[Dimensions: Captured Height (mm)],[Gross Weight (g)],"
    strSQL = strSQL & "[Ingredients],[Nutrition],[Per100 Energy (kJ)],[Per100 Energy (kcal)],[Per100 Fat (g)],"
    strSQL = strSQL & "[Per100 thereof Sat Fat (g)],[Per100 Carbohydrates (g)],[Per100 thereof Total Sugar (g)],"
    strSQL = strSQL & "[Per100 Protein (g)],[Per100 Fibre (g)],[Per100 Sodium (g)],[Per100 Salt (g)],"
    strSQL = strSQL & "[PerServing PortionType],[PerServing Energy (kJ)],[PerServing Energy (kcal)],"
    strSQL = strSQL & "[PerServing Fat (g)],[PerServing thereof Sat Fat (g)],[PerServing Carbohydrates (g)],"
    strSQL = strSQL & "[PerServing thereof Total Sugar (g)],[PerServing Protein (g)],[PerServing Fibre (g)],"
    strSQL = strSQL & "[PerServing Salt (g)],[Net Content] "
    strSQL = strSQL & " INTO TEMPO "
    strSQL = strSQL & " FROM [Soaps$]"
    strSQL = strSQL & " ORDER BY [GTIN],[PVID],[Version Date]"

'    strSQL = strSQL & " FROM [Excel 12.0 Xml; HDR=YES;IMEX=1;Database=" & FileSelector() & "].[Drinks$]"


    With objCon
        .provider = "Microsoft.ACE.OLEDB.12.0;"
        .ConnectionString = "Data Source=" & FileSelector() & ";Extended Properties=""Excel 12.0;HDR=YES;IMEX=0;"""
        .Open
        Set objRS = .Execute(strSQL)
    End With

    Application.RefreshDatabaseWindow
'    CurrentDb.TableDefs.Refresh

    Set objRS = Nothing
    Set objCon = Nothing

    DoCmd.SetWarnings True

End Sub

这是检查表是否存在的函数。

Function IsTableExists(TblName As String) As Boolean
    IsTableExists = False
    If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & TblName & "' And Type In (1,4,6)")) Then IsTableExists = True
End Function

这是选择文件和路径名的功能。

Function FileSelector() As String
    Dim dlg As Object

    Set dlg = Application.FileDialog(3) 'msoFileDialogFilePicker
    With dlg
        .Title = "Select the Excel data extract to import"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xlsx", 1

        If .Show = -1 Then
            FileSelector = .SelectedItems(1)
        Else
            End
        End If
    End With

    Set dlg = Nothing

End Function

Answer 1

只需删除与Excel工作簿的任何ADO连接，并将Excel连接内联运行到MS Access查询。然后，使用CurrentDb.Execute：

执行生成表查询

strSQL = "SELECT "
strSQL = strSQL & "[GTIN],[PVID],[Version Date],[Languages on Pack],[Description],[Brand],[Features],"
strSQL = strSQL & "[Other Information],[Trademark Information],[Safety Warnings],[Country],"
strSQL = strSQL & "[Manufacturers Address],[Importer Address],[Return To],[Web Address],[Recycling],"
strSQL = strSQL & "[Recycling Other Text],[Dimensions: Captured Height (mm)],[Gross Weight (g)],"
strSQL = strSQL & "[Ingredients],[Nutrition],[Per100 Energy (kJ)],[Per100 Energy (kcal)],[Per100 Fat (g)],"
strSQL = strSQL & "[Per100 thereof Sat Fat (g)],[Per100 Carbohydrates (g)],[Per100 thereof Total Sugar (g)],"
strSQL = strSQL & "[Per100 Protein (g)],[Per100 Fibre (g)],[Per100 Sodium (g)],[Per100 Salt (g)],"
strSQL = strSQL & "[PerServing PortionType],[PerServing Energy (kJ)],[PerServing Energy (kcal)],"
strSQL = strSQL & "[PerServing Fat (g)],[PerServing thereof Sat Fat (g)],[PerServing Carbohydrates (g)],"
strSQL = strSQL & "[PerServing thereof Total Sugar (g)],[PerServing Protein (g)],[PerServing Fibre (g)],"
strSQL = strSQL & "[PerServing Salt (g)],[Net Content] "
strSQL = strSQL & " INTO TEMPO "
strSQL = strSQL & " FROM [Excel 12.0; HDR=YES;IMEX=0;Database=" & FileSelector() & "].[Soaps$]"
strSQL = strSQL & " ORDER BY [GTIN],[PVID],[Version Date]"

CurrentDb.Execute strSQL, dbFailOnError

至于错误，记录太大，请参阅此MS Office documentation，其中表示设计的限制：

更新或添加文本字段时会出现以下错误在一个表中，总记录大小超过大约2000字节字段组合（不包括备注字段）

使用unicode压缩，每个记录限制可以增加到4,000字节（4K）。

对于你来说，当N = 156列时，任何一行中每个单元格的字符数超过13个字符，就可以达到此记录限制。可能您有一个包含大量文本数据的字段，您可以在SELECT子句中尝试忽略这些数据。或者，尝试使用许多 PerServing 和 Per100 字段将表设计标准化为一对多，因为它们往往会重复。见下面的例子：

UniqueID | ContentType                | ContentValue
-------------------------------------------------------
1001     | Per100 Energy (kJ)         | 1000
1001     | Per100 Energy (kcal)       | 750
1001     | Per100 Fat (g)             | 250
1001     | Per100 thereof Sat Fat (g) | 20
1001     | Per100 Carbohydrates (g)   | 1400
...

使用此架构，您需要为 Temp 运行两个生成表导入，其中包含不同的记录， ContentTable 用于多项记录，其中 UniqueID 链接两个表。一个是指标字段的简单SELECT查询，另一个是内容类型字段的迭代追加查询。稍后，您可以随时运行crosstab query以将长格式重新整形为Excel工作簿。请注意，任何Access表/查询都限制为255列。

TEMPO

strSQL = "SELECT "
strSQL = strSQL & "[GTIN],[PVID],[Version Date],[Languages on Pack],[Description],[Brand],[Features],"
strSQL = strSQL & "[Other Information],[Trademark Information],[Safety Warnings],[Country],"
strSQL = strSQL & "[Manufacturers Address],[Importer Address],[Return To],[Web Address],[Recycling],"
strSQL = strSQL & "[Recycling Other Text],[Dimensions: Captured Height (mm)],[Gross Weight (g)],"
strSQL = strSQL & "[Ingredients],[Nutrition] "
strSQL = strSQL & " INTO TEMPO "
strSQL = strSQL & " FROM [Excel 12.0; HDR=YES;IMEX=0;Database=" & FileSelector() & "].[Soaps$]"
strSQL = strSQL & " ORDER BY [GTIN],[PVID],[Version Date]"

CurrentDb.Execute strSQL, dbFailOnError

<强> ContentTable

...
Dim var As Variant
Dim qdef As QueryDef
Dim strFileName As String

strFileName = FileSelector() 

' FIRST CONTENT TYPE TO CREATE TABLE
strSQL = strSQL & " SELECT [UniqueIDColumn] As UniqueID,"
strSQL = strSQL & "        'Per100 Energy (kJ)' As ContentType,"
strSQL = strSQL & "        [Per100 Energy (kJ)] As ContentValue"
strSQL = strSQL & " INTO ContentTable"
strSQL = strSQL & " FROM [Excel 12.0; HDR=YES;IMEX=0;Database=" & strFileName & "].[Soaps$]"

CurrentDb.Execute strSQL, dbFailOnError

' SECOND TYPE AND ONWARD TO APPEND TO TABLE
For Each var in Array("Per100 Protein (g)", "Per100 Fibre (g)", "Per100 Sodium (g)", "Per100 Salt (g)", _
                      "PerServing PortionType", "PerServing Energy (kJ)", "PerServing Energy (kcal)", _
                      "PerServing Fat (g)", "PerServing thereof Sat Fat (g)", "PerServing Carbohydrates (g)", _
                      "PerServing thereof Total Sugar (g)", "PerServing Protein (g)", "PerServing Fibre (g)", _
                      "PerServing Salt (g)", "Net Content")

     strSQL = "PARAMETERS [ContentTypeParam] TEXT;"
     strSQL = strSQL & " INSERT INTO ContentTable (UniqueID, ContentType, ContentValue)"
     strSQL = strSQL & " SELECT [UniqueIDColumn], [ContentTypeParam], [" & var & "]"
     strSQL = strSQL & " FROM [Excel 12.0; HDR=YES;IMEX=0;Database=" & strFileName & "].[Soaps$]"

     Set qdef = CurrentDb.CreateQueryDef("", strSQL)
     qdef![ContentTypeParam] = var    
     qdef.Execute dbFailOnError

     Set qdef = Nothing
Next var

执行RefreshDatabaseWindow后，表格仍未显示

1 个答案: