如果工作表包含下拉列表,则在访问中导入Excel数据时出现问题

时间:2012-09-03 20:27:43

标签: excel vba ms-access ms-access-2007 import-from-excel

我创建了一个excel工作表,用户可以插入一些行(最多100行)。

从下拉列表中选择某些字段的值。

我把公式放在所有100行上。

问题是如果用户插入少于100行,则不会在访问中导入数据。在这种情况下,仅当我从剩余行中删除下拉列表的公式时才导入数据。

要在访问中导入Excel数据,我使用:

DoCmd.TransferSpreadsheet [Transfer Type], [Spreadsheet Type], [Table Name], [File Name], [Has Field Names], [Range]

我该如何解决这个问题?

修改

在Remou的回答之后,我尝试了:

Private Sub import_Click()

Dim openDialog As FileDialog
Dim FileChosen As Integer

Set openDialog = Application.FileDialog(msoFileDialogFilePicker)
On Error GoTo DoNothing
With openDialog
  .title = "Import"
  .AllowMultiSelect = False
  .Show
End With

filename = openDialog.SelectedItems.Item(1)

Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim rng As Excel.Range

Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wb = xl.Workbooks.Open(nomeFile)

c = wb.Worksheets("Sheet1").Range("1:1").end(-4161).Address
r = wb.Worksheets("Sheet1").Range("A:A").end(-4121).Row

ImportRange = "Sheet1!" & "A1:" _
   & Replace(Mid(c, 1, InStrRev(c, "$")) & r, "$", "")

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, _
"ImportTable", filename, True, ImportRange

DoNothing:
    If Err.Number = cdlCANCEL Then
    End If

End Sub

但我在 Dim xl As Excel.Application

上遇到调试错误

1 个答案:

答案 0 :(得分:1)

注意使用Excel下拉列表和验证下拉列表进行测试后,我发现使用已验证的单元格或未使用范围中的下拉列表导入数据时没有任何问题,除非导入这些行,即使所有其他单元格都为空。问题可能出在数据类型和导入现有表中。您可能必须导入临时表,然后追加。

我建议您使用自动化来获取已使用的范围,并将其添加为要导入的范围。

此示例代码使用后期绑定。您可以添加对Microsoft Excel x.x对象库的引用,因此我保留了各种定义,但如果您在多台PC上使用该代码,则最好绑定。

Dim xl As Object ''Excel.Application
Dim wb As Object ''Excel.Workbook
Dim rng As Object ''Excel.Range

Set xl = CreateObject("Excel.Application")
xl.Visible = True
Set wb = xl.Workbooks.Open("z:\docs\test.xlsx")

'Choosing a column that is fully filled on sheet5
'xldown=-4121,xltoright=-4161
c = wb.Worksheets("Sheet5").Range("1:1").end(-4161).Address
r = wb.Worksheets("Sheet5").Range("A:A").end(-4121).Row

ImportRange = "Sheet5!" & "A1:" _
    & Replace(Mid(c, 1, InStrRev(c, "$")) & r, "$", "")

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
    "ImportSheet2", "Z:\Docs\csharp.xlsm", True, ImportRange