Question

我想从File dailog中选择是否存在excel文件中名为“Metadasheet”的工作表。

我的目标步骤如下：文件dailog打开＆gt;选择excel文件＆gt;检查“Metadatasheet”是否存在＆gt;如果“是”，则执行操作＆gt;如果“否”弹出“选择正确的工作簿”。以下是代码（在访问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

任何建议都非常有用。谢谢你！

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，并且在所选工作簿不包含预期工作表时显示对话框。在函数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

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

2 个答案: