在Application.FileDialog中selectexcel文件后,检查是否存在特定的工作表

我想从文件dailog中select是否在Excel文件中存在名为“元数据表”的表格。

我的目标步骤如下:文件dailog打开>selectexcel文件>检查“Metadatasheet”是否存在>如果“是”,执行操作>如果“否”popup“select正确的工作簿”。 以下是代码(在访问VBA),我想知道,我如何以及在哪里把这个检查;

Public Function create(LatestSNR As String, Metadatasheet As String) ' LatestSNR is the name of the table or query you want to send to Excel ' Metadatasheet is the name of the sheet you want to send it to Dim rst As DAO.Recordset Dim ApXL As Object Dim xlWBk As Object Dim xlWSh As Object Dim fld As DAO.Field Dim strFile As String Const xlCenter As Long = -4108 Const xlBottom As Long = -4107 On Error GoTo err_handler With Application.FileDialog(1) ' msoFileDialogOpen .Filters.Clear .Filters.Add "Excel workbooks (*.xls*)", "*.xls*" If .Show Then strFile = .SelectedItems(1) Else MsgBox "No workbook specified!", vbExclamation Exit Function End If End With Set rst = CurrentDb.OpenRecordset(LatestSNR) Set ApXL = CreateObject("Excel.Application") Set xlWBk = ApXL.Workbooks.Open(strFile) ApXL.Visible = True Set xlWSh = xlWBk.Worksheets(Metadatasheet) xlWSh.Activate xlWSh.Range("A2").Select For Each fld In rst.Fields ApXL.ActiveCell = fld.Name ApXL.ActiveCell.Offset(0, 1).Select Next rst.MoveFirst xlWSh.Range("A2").CopyFromRecordset rst xlWSh.Range("1:1").Select ' selects all of the cells ApXL.ActiveSheet.Cells.Select ' selects the first cell to unselect all cells xlWSh.Range("A2").Select rst.Close Set rst = Nothing Exit Function err_handler: DoCmd.SetWarnings True MsgBox Err.Description, vbExclamation, Err.Number Exit Function End Function 

任何build议是非常有益的。感谢提前!

在下面的示例中, Application.FileDialog(1)使用do-loop封装,并且所选工作簿不包含预期工作表时显示对话框。 在函数GetWorksheet中检查完成,如果预期工作表不存在,则显示消息框。 HTH

 Option Explicit Private ApXL As Object Private Const Metadatasheet As String = "Metadatasheet" Function test() Dim strFile As String Dim xlWSh As Object Set ApXL = CreateObject("Excel.Application") Set xlWSh = Nothing Do With Application.FileDialog(1) ' msoFileDialogOpen .Filters.Clear .Filters.Add "Excel workbooks (*.xls*)", "*.xls*" If .Show Then strFile = .SelectedItems(1) Set xlWSh = GetWorksheet(ApXL, strFile) Else MsgBox "No workbook specified!", vbExclamation ApXL.Quit Exit Function End If End With Loop While xlWSh Is Nothing ' Do the job ... ' Code continues using 'xlWSh' ' Set rst = CurrentDb.OpenRecordset(LatestSNR) ' ApXL.Visible = True ' ... ' Quit excel ApXL.Quit End Function Private Function GetWorksheet(ApXL, file) As Object Dim xlWBk As Object Set GetWorksheet = Nothing Set xlWBk = ApXL.Workbooks.Open(file) On Error Resume Next Set GetWorksheet = xlWBk.Worksheets(Metadatasheet) On Error GoTo 0 If Not GetWorksheet Is Nothing Then _ Exit Function If Not xlWBk Is Nothing Then _ xlWBk.Close savechanges:=False MsgBox "Workbook '" & file & "' doesn't contain sheet '" & Metadatasheet & _ "'. Choose the correct workbook.", vbExclamation End Function 

您可以使用以下布尔函数

 Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean WorksheetExists = False Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets If sh.Name = WorksheetName Then WorksheetExists = True Exit For End If Next sh End Function