Question

您好，感谢您的帮助。我正在整理一个看似简单的Access数据管理解决方案，供我们办公室使用，我遇到了麻烦，因为我在vba中的背景充其量只是最小的。

我这里有两个相关但断开连接的Access 2007应用程序，我需要一个系统供用户轻松导入和导出此信息。我现在有一个脚本工作，将应用程序中的所有表导出到一个excel文件中，每个表作为一个不同的工作表，问题是当我去导入它时，似乎只找到第一个导入表。 / p>

我希望找到一种迭代每个工作表，获取工作表名称，然后根据工作表名称将该数据合并到表中的方法。

澄清：

App A的多个副本被发送到各个部门
App A：用户在表格中输入信息
应用程序A：用户按命令运行导出宏
创建Excel文件时将每个表作为具有匹配名称的工作表（例如tblCourse，tblStudent，tblFaculty等）
App B的用户收到excel电子表格
App B：用户按命令运行导入脚本（这是我正在寻找的解决方案）
- 提示用户输入文件位置
- 导入脚本打开excel工作簿
- 脚本遍历每个工作表，读取名称，并将数据导入匹配名称的表

提前感谢您提供的任何帮助，非常感谢。

修改

工作脚本（非常感谢grahamj42的帮助）：

Private Sub Command101_Click()

'Dim excelapp As New Excel.Application
Dim excelApp As Object
Set excelApp = CreateObject("Excel.Application")
'Dim excelbook As New Excel.Workbook
Dim excelbook As Object
Set excelbook = excelApp.Workbooks.Add
'Dim excelsheet As New Excel.Worksheet
'Dim excelsheet As Object
'Set excelsheet = excelbook.Sheets
Dim intNoOfSheets As Integer, intCounter As Integer
Dim strFilePath As String, strLastDataColumn As String
Dim strLastDataRow As String, strLastDataCell As String

strFilePath = "C:\Users\UserName\Documents\Export\DatabaseExport03-28-2013.xlsx"

Set excelbook = excelApp.Workbooks.Open(strFilePath)

 intNoOfSheets = excelbook.worksheets.Count

 Dim CurrSheetName As String

 For intCounter = 1 To intNoOfSheets
  excelbook.worksheets(intCounter).Activate
   DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, ActiveSheet.Name, _
   strFilePath, True, _
   excelbook.Worksheets(intCounter).Name & "!" & _
   Replace(excelbook.Worksheets(intCounter).UsedRange.Address, "$", "")
 Next

excelbook.Close
excelApp.Quit
Set excelApp = Nothing

End Sub

请注意，在DoCmd.TransferSpreadsheet命令中，有一个HasFieldNames属性在此处设置为“True”，因为我的电子表格导出时将字段名称作为列标题。

Answer 1

使用Selection而不选择任何内容将在工作表中保存时引用所选单元格。虽然我没有看到，在你的情况下，为什么这应该在桌子之外，你可以做得更好，而不用Worksheet.UsedRange选择任何东西：

For intCounter = 1 To intNoOfSheets

  DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, Activesheet.Name, _
    strFilePath, True, _
    excelbook.Worksheets(intCounter).Name & "!" & _
    Replace(excelbook.Worksheets(intcounter).UsedRange.Address, "$", "")

Next

Answer 2

由于我不想对位置或文件名进行硬编码，因此我对两个不同的代码做了一些组合。

Dim excelApp As Object
Dim excelbook As Object
Dim dlg As FileDialog
Dim StrFileName As String, intcounter, intNoOfSheets As Integer


Set excelApp = CreateObject("Excel.Application")
Set dlg = Application.FileDialog(msoFileDialogFilePicker)

With dlg
    .Title = "Select the Excel file to import"
    .AllowMultiSelect = False
    .Filters.Clear
    .Filters.Add "Excel Files", "*.xlsx", 1
    .Filters.Add "All Files", "*.*", 2

    If .Show = -1 Then

        StrFileName = .SelectedItems(1)
        Set excelbook = excelApp.Workbooks.Open(StrFileName)
        intNoOfSheets = excelbook.worksheets.Count
        'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "COR Daily",     StrFileName, True
        For intcounter = 1 To intNoOfSheets
            excelbook.worksheets(intcounter).Activate
            DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8,     excelbook.Activesheet.Name, StrFileName, True, _
            excelbook.worksheets(intcounter).Name & "!" & _
            Replace(excelbook.worksheets(intcounter).UsedRange.Address, "$", "")

        Next

    Else
        Exit Function

    End If

End With
End Function

按工作表名称将多个工作表从Excel文件导入多个表

修改

2 个答案: