Question

我需要从Excel电子表格导入数据。电子表格有多个工作表，但我只对组件的工作表感兴趣。工作表名称每个月都有所不同，但始终以“组件”开头。我正在寻找一种以编程方式找到正确工作表的方法。

解决方案可能在于获取工作表的代码名称属性，但我不知道该怎么做。

FWIW，我不控制电子表格，因此无法控制命名范围的使用（他们不使用它们），也无法控制工作表的命名约定。

Private Sub cmdGetFile_Click()
'Import components spreadsheet into components table
    Dim fDlg As FileDialog
    Dim flNme As String
    Dim flChsn As Integer

    Set fDlg = Application.FileDialog(msoFileDialogOpen)

    fDlg.Title = "Select Products & Components file"
    flChsn = fDlg.Show
    fDlg.FilterIndex = 1

    If flChsn <> -1 Then
       MsgBox "No file selected"
    Else
       flNme = fDlg.SelectedItems(1)
    End If

    DoCmd.TransferSpreadsheet , acSpreadsheetTypeExcel12, "component", flNme, -1, [this is where I need help]
End Sub

Answer 1

是否有一种模式可以让您“猜测”工作表的名称？即它是唯一以'组件'开头的表吗？其中一张纸的某个单元格中会有日期吗？在英语中，描述您选择表单的方式，如果您要查看它。

以下将列出工作簿中的所有工作表名称，然后要求您键入工作表的名称。如果您可以定义如何识别，则可以更改代码以执行此操作。

Option Compare Database
Option Explicit

Private Sub cmdGetFile_Click()
    'Import components spreadsheet into components table
    Dim fDlg As FileDialog
    Dim flNme As String
    Dim flChsn As Integer

    Set fDlg = Application.FileDialog(msoFileDialogOpen)

    fDlg.Title = "Select Products & Components file"
    flChsn = fDlg.Show
    fDlg.FilterIndex = 1

    If flChsn <> -1 Then
       MsgBox "No file selected"
    Else
       flNme = fDlg.SelectedItems(1)
    End If

    ' Open the Workbook and display a list of sheet names
    Dim excelApp    As Excel.Application
    Dim oWB         As Excel.Workbook
    Dim oWS         As Excel.Worksheet
    Dim strSheets   As String
    Dim strRange    As String
    Dim i           As Integer
    Dim strSheet    As String
    Dim iLastrow    As Long
    Dim iLastCol    As Long

    Set excelApp = New Excel.Application
    Set oWB = excelApp.Workbooks.Open(flNme)
    excelApp.Visible = True

    ' Get all Sheet Names
    strSheets = ""
    For i = 1 To oWB.Worksheets.Count
        strSheets = strSheets & oWB.Worksheets(i).Name & vbCr
    Next i

AskAgain:
    ' Display the list
    MsgBox "List of all worksheet names:" & vbCrLf & strSheets

    strSheet = InputBox("Please enter the name of the Worksheet to import.", "Sheet Name?")
    If InStr(1, strSheets, strSheet) = 0 Then
        MsgBox "You entered a sheet name that does not exist.", vbOKOnly, "Unknown Sheet Name"
        GoTo AskAgain
    End If

    ' Get Cell Range... Assume range starts in A1????
    Set oWS = oWB.Sheets(strSheet)

    ' Get last used row
    iLastrow = oWS.Cells(oWS.rows.Count, 1).End(xlUp).Row
    ' Build Import range (Sheet & cells)
    strRange = strSheet & "!A1:BM" & iLastrow                   ' i.e.  "SheetName!A1:P25"

    oWB.Close SaveChanges:=False        ' Close, don't save any changes
    Set oWB = Nothing
    Set excelApp = Nothing

    ' Import worksheet
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "component", flNme, -1, strRange         '[this is where I need help]


End Sub

Answer 2

由于我知道工作表代码名称属性（它始终是Sheet3），我可以参考工作表编号，而不是在对话框中手动输入名称的过程。

非常感谢Wayne G. Dunn，你清晰而精心编写的答案帮助我填补了几个缺失的部分！用于查找电子表格名称，显示它们并允许用户输入的代码我将保存为将来使用的一个很好的示例。

所以这是最终的代码：

Option Compare Database
Option Explicit

Private Sub cmdGetFile_Click()
'Import components spreadsheet into components table
Dim fDlg As FileDialog
Dim flNme As String
Dim flChsn As Integer

Set fDlg = Application.FileDialog(msoFileDialogOpen)

fDlg.Title = "Select Products & Components file"
flChsn = fDlg.Show
fDlg.FilterIndex = 1

If flChsn <> -1 Then
   MsgBox "No file selected"
Else
   flNme = fDlg.SelectedItems(1)
End If

' Open the Workbook and display a list of sheet names
Dim excelApp    As Excel.Application
Dim oWB         As Excel.Workbook
Dim oWS         As Excel.Worksheet
Dim strSheets   As String
Dim strRange    As String
Dim i           As Integer
Dim strSheet    As String
Dim iLastrow    As Long
Dim iLastCol    As Long

Set excelApp = New Excel.Application
Set oWB = excelApp.Workbooks.Open(flNme)
excelApp.Visible = False    'Don't need to see the workbook

' Sheet 3 is the worksheet that I want to import
i = 3
strSheet = strSheets & oWB.Worksheets(3).Name

' Get Cell Range starting in A1
Set oWS = oWB.Sheets(strSheet)

' Get last used row
iLastrow = oWS.Cells(oWS.rows.Count, 1).End(xlUp).Row

' Build Import range (Sheet & cells)
strRange = strSheet & "!A1:L" & iLastrow   ' i.e.  "SheetName!A1:P25"

oWB.Close SaveChanges:=False        ' Close, don't save any changes
Set oWB = Nothing
Set excelApp = Nothing

' Import worksheet
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "component", flNme, -1, strRange


End Sub

导入Excel电子表格，其中工作表名称每月变化

2 个答案: