3

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

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

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

澄清：

  • App A的多份副本被发送到各个部门
  • 应用 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”，因为我的电子表格以字段名称作为列标题导出。

4

2 回答 2

3

您在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
于 2013-03-28T19:28:41.730 回答
0

我对两段不同的代码做了一点组合，因为我不想硬编码位置或文件名。

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
于 2019-05-30T16:38:35.000 回答