即使在执行刷新数据库窗口后，表也不会显示

Question

我正在尝试使用"SELECT (columns， ，，) INTO TEMPO FROM ..."将 excel 工作表中的一些列(实际上包含 156 列 x 16k 行)拉入动态创建的表中，但尽管代码执行，但该表不会出现在导航窗格中。有时，它会在 上给出错误。执行 (StrSQL) 行"表已存在"。

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

我也尝试过DoCmd.TransferSpreadsheet来提取工作表数据，但它导致了"记录太大"错误。同样，对于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 连接，然后以内联方式运行 MS Access 查询的 Excel 连接。然后，使用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文档，其中指示设计设置的限制：

以下错误是更新或添加文本字段时的结果 在表中，并且所有记录的总记录大小超过 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运行两个生成表导入，并为UniqueID链接两个表的多项目记录运行ContentTable导入。一个是针对指示器字段的简单SELECT查询，另一个是针对内容类型字段的迭代追加查询。稍后，您始终可以运行交叉表查询，将长格式重新塑造回 Excel 工作簿的宽格式。请注意，任何 Access 表/查询都有 255 列的限制。

速度

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

内容表

...
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