通过工作表名称将多个工作表从Excel文件导入到多个表中 [英] Importing multiple sheets from an excel file into multiple tables by sheet name

问题描述

您好，谢谢您的帮助.我正在整理一个看似简单的Access数据管理解决方案，以便在我们的办公室使用，但由于在vba中的背景充其量很少，因此我遇到了麻烦.

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

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

要澄清:

• 将App A的多个副本发送到各个部门
• 应用A:用户在表格中输入信息
• 应用A:用户按下命令即可运行导出宏
• 将每个表格作为具有匹配名称(例如tblCourse，tblStudent，tblFaculty等)的表格创建Excel文件
• 应用B的用户会收到excel电子表格
• 应用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"，因为我的电子表格将字段名称作为列标题导出.

解决方案

在不选择任何内容的情况下使用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

Hi there and thanks for your help. I'm putting together a seemingly simple Access data management solution for use in our office here and I'm having trouble as my background in vba is minimal at best.

What I have here are two related but disconnected Access 2007 applications and I need a system for the user to easily import and export this information. I've got a script working now to export all the tables from the application into a single excel file with each table as a different worksheet, the issue is that when I go to import it only seems to find the first sheet for import.

What I'm hoping to find is a method to iterate over each worksheet, grab the sheet name, and then merge that data into the table based on the sheet name.

To clarify:

• Multiple copies of App A are sent to various departments
• App A: Users enter information into the tables
• App A: Users press command to run export macro
• Excel file is created with each table as a sheet with matching names (e.g. tblCourse, tblStudent, tblFaculty, etc.)
• Users of App B receive excel spreadsheet
• App B: Users press command to run import script (This is the solution I'm looking for)
  • User is prompted for file location
  • Import script opens excel workbook
  • Script iterates over each sheet, reads name, and imports data to table of matching name

Thanks in advance for any help you can provide, much appreciated.

Edit

Working script (Thanks greatly to grahamj42's help here):

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

Note that in the DoCmd.TransferSpreadsheet command there is a HasFieldNames property that is set to 'True' here because my spreadsheets export with the field names as column headers.

解决方案

Your use of Selection without selecting anything will refer to the selected cell in the worksheet when it was saved. While I don't see, in your case, why this should be outside the table, you could do better like this without selecting anything by using 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

这篇关于通过工作表名称将多个工作表从Excel文件导入到多个表中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！