在 Application.FileDialog 中选择 excel 文件后检查特定工作表是否存在

Question

我想在从文件 dailog 中选择时检查 sheet 名为 "Metadasheet" 的文件是否存在于 excel 文件中。

我的目标步骤如下：文件 dailog 打开> select excel 文件> 检查 "Metadatasheet" 是否存在> 如果 "yes"，执行操作> 如果 "no" 弹出 "choose the correct workbook"。以下是代码（在访问 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

任何建议都非常helpful.Thanks提前！

Answer 1

您可以使用以下布尔函数

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

Answer 2

在以下示例中，Application.FileDialog(1) 被 do-loop 包裹，并且在所选工作簿不包含预期工作时显示对话框 sheet。在函数 GetWorksheet 中，检查已完成，如果预期的 sheet 不存在，则会显示消息框。 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

在 Application.FileDialog 中选择 excel 文件后检查特定工作表是否存在

Check if particular worksheet exists after choosing excel file in Application.FileDialog

excel

ms-access

vba