将不带标题、VBA、TransferSpreadsheet 方法的 Excel 行导入 MS-Access

Question

（使用 MS Office Professional Plus 2016）

我调整了这个子过程，将 MS-Excel 文件/它们的第一个工作表（称为“表”）导入 MS-Access 数据库。代码导航到指定的文件夹并导入该文件夹中的所有 .xls 文件。所有 .xls 文件都具有相同的格式。我正在使用 DoCmd.TransferSpreadsheet 和 Do While。

但是，各个 .xls 文件中“表格”工作表中的相关数据从第 29 行开始，字段名称在第 28 行。

我的问题是：有没有办法只将第 28 行中的字段名称和第 29 行中的数据导入到最后一个非空行 - 一种将其包含在 Do While 中的方法？也许使用 TransferSpreadsheet 命令中的 Range 选项，但我不知道如何在“第 x 行到最后一个非空行”范围内表达。

Option Compare Database

Sub importfiles()

Dim blnHasFieldNames As Boolean
Dim strWorksheet As String, strTable As String
Dim strPath As String, strPathFile As String

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "E:\importfiles\"

' Replace worksheetname with the real name of the worksheet that is to be
' imported from each file
strWorksheet = "Table"

' Import the data from each workbook file in the folder
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & strFile
      strTable = "tbl_" & Left(strFile, InStrRev(strFile, ".xls") - 1)

      DoCmd.TransferSpreadsheet acImport, _
            acSpreadsheetTypeExcel9, strTable, strPathFile, _
            blnHasFieldNames, strWorksheet & "$"

      ' Uncomment out the next code step if you want to delete the
      ' EXCEL file after it's been imported
      ' Kill strPathFile

      strFile = Dir()
Loop
MsgBox ("The sub was run.")

End Sub


Public Function runImport()

Call importfiles

End Function

(I slightly adapted this code from http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpWktFilesSepTbls)


EDIT:
[Type mismatch, see Max's answer][1]
 [Screenshot of excel file][2]

 [access table][3]

 [Compile error(see Max's answer)][4]


[for max][5]
[for max2][6]
[for max3][7]


  [1]: https://i.stack.imgur.com/PZFnl.png
  [2]: https://i.stack.imgur.com/IjvKc.png
  [3]: https://i.stack.imgur.com/jzOXu.png
  [4]: https://i.stack.imgur.com/uHUTK.png
  [5]: https://i.stack.imgur.com/slAeG.png
  [6]: https://i.stack.imgur.com/g6fNr.png
  [7]: https://i.stack.imgur.com/gFNqA.png

Answer 1

这里有一个建议，即在导入之前打开 excel 文件并定义要导入的区域。负 27 或多或少是被猜到的，请在该区域的 excel 中检查 - 可能不同，只需更改数字即可。 第二个更改是您在 transferspreadsheet-command 中定义要导入的区域。

我希望这会有所帮助。 最大

Sub importfiles()

Dim blnHasFieldNames As Boolean
Dim strWorksheet As String, strTable As String
Dim strPath As String, strPathFile As String

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "E:\importfiles\"

' Replace worksheetname with the real name of the worksheet that is to be
' imported from each file
strWorksheet = "Table"

' Import the data from each workbook file in the folder
strFile = Dir(strPath & "*.xls")
Do While Len(strFile) > 0
      strPathFile = strPath & strFile



''''alter the excel file
        Call alter_excel(strPathFile, strWorksheet)

      DoCmd.TransferSpreadsheet acImport, _
            acSpreadsheetTypeExcel9, strTable, strPathFile, _
            blnHasFieldNames, "importarea"

      ' Uncomment out the next code step if you want to delete the
      ' EXCEL file after it's been imported
      ' Kill strPathFile

      strFile = Dir()
Loop
MsgBox ("The sub was run.")

End Sub

Function alter_excel(file As String, table As String)
Dim oXL As New Excel.Application
Dim oWB As Excel.Workbook
     Set oXL = CreateObject("Excel.Application") 
     Set oWB = oXL.Workbooks.Open(file)
        oWB.Activate
        Sheets(table).Select
        Range("A30:D" & WorksheetFunction.CountA(Columns(1)) + 5).Name = "importarea"

        oWB.Close True
        Set oWB = Nothing
        Set oXL = Nothing
End Function

Answer 2

只需在TransferSpreadsheet 的范围 参数中使用从第一个到最后一个单元格的A1 样式地址，其中包括标题作为第一行。如果行是开放式的，请输入一个非常大的末尾行，有趣的是未导入未使用的范围！

Do While Len(strFile) > 0
   strPathFile = strPath & strFile

    DoCmd.TransferSpreadsheet acImport, _
        acSpreadsheetTypeExcel9, "myFinalTable", strPathFile, _
        True, strWorksheet & "$A29:D1000"

   strFile = Dir()
Loop

或者，您可以直接在 Access SQL 中查询 Excel 工作簿：

SELECT *
FROM [Excel 12.0 Xml; HDR = Yes;Database=C:\Path\To\myWorkbook.xlsx].[mySheet1$A29:D1000]

事实上，您可以随后从 Excel 源运行追加查询（可能比TransferSpreadsheet 更有效）。

Do While Len(strFile) > 0
   strPathFile = strPath & strFile

   sql = "INSERT INTO myFinalTable" _
         & " SELECT * " _
         & " FROM [Excel 12.0 Xml; HDR = Yes;Database=" & strPathFile & "].[" & strWorksheet & "$A29:D1000]"

   Currentdb.Execute sql, dbFailOnError

   strFile = Dir()
Loop

请注意：为了遵守数据库规范化，您应该将所有数据迁移到一个的长表，而不是可以运行到数百甚至更多的单独的电子表格表。与 Excel 电子表格不同，Access 表格没有行数限制。