如何检查此代码中是否存在工作表[重复]

Question

我已经为测试邮件设置了宏并移动它们。但是，如果我得到另一个 excel 文件，另一个工作表名称在哪里，那么我会收到 VBA 错误：subscript out of range。

错误在这一行：Set xlSheet = xlWB.sheets("MySheet1")

Option Explicit

Sub CheckAttachments(olItem As MailItem)

Const strPath As String = "C:\Users\PC2\Documents\Temp_attachs\"
Const strFindText As String = "Completed"
Dim strFilename As String
Dim olAttach As Attachment
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim bXStarted As Boolean
Dim bFound As Boolean

Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("MyFolder1")


 If olItem.Attachments.Count > 0 Then
     For Each olAttach In olItem.Attachments
         If Right(LCase(olAttach.FileName), 4) = "xlsx" Then
             strFilename = strPath & Format(olItem.ReceivedTime, "yyyymmdd-HHMMSS") & _
                           Chr(32) & olAttach.FileName
             olAttach.SaveAsFile strFilename
             On Error Resume Next
             Set xlApp = GetObject(, "Excel.Application")
             If Err <> 0 Then
                 Application.StatusBar = "Please wait while Excel source is opened ... "
                 Set xlApp = CreateObject("Excel.Application")
                 bXStarted = True
             End If
             On Error GoTo 0
             'Open the workbook to read the data
             Set xlWB = xlApp.workbooks.Open(strFilename)
             Set xlSheet = xlWB.sheets("MySheet1")

             If FindValue(strFindText, xlSheet) Then
                olItem.Move myDestFolder

                'MsgBox "Value found in " & strFilename
                 bFound = True
             End If
             xlWB.Close 0
             If bXStarted Then xlApp.Quit
             If Not bFound Then Kill strFilename


             'Exit For
         End If
     Next olAttach
  End If
 End Sub

如何测试工作表，如果不存在则退出 sub (errorhandling: exit sub)？

Answer 1

要检查Sheet 是否存在，您可以使用如下代码：

On Error Resume Next
Set xlSheet = xlWB.Sheets("MySheet1")

If xlSheet Is Nothing Then
    MsgBox "Sheet not found!", vbCritical
    Exit Sub
End If

On Error GoTo 0

希望这会有所帮助。

Answer 2

您可以按如下方式调整您的代码：

Sub foo()
    Dim xlSheet As Object
    Dim xlWB As Object

    On Error Resume Next
        Set xlWB = ThisWorkbook
        Set xlSheet = xlWB.Sheets("MySheet2")
    On Error GoTo 0

    If xlSheet Is Nothing Then
        Debug.Print "sheet is missing"
    Else
        Debug.Print "sheet is not missing"
    End If
End Sub

在设置 xlSheet 值后，只需移动“On Error GoTo 0”语句，然后添加另一个“If”语句来检查是否应该继续执行其余代码。

Answer 3

这应该适合你：

Sub CheckAttachments(olItem As MailItem)

Const strPath As String = "C:\Users\PC2\Documents\Temp_attachs\"
Const strFindText As String = "Completed"
Dim strFilename As String
Dim olAttach As Attachment
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim bXStarted As Boolean
Dim bFound As Boolean

Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myDestFolder = myInbox.Folders("MyFolder1")


 If olItem.Attachments.Count > 0 Then
     For Each olAttach In olItem.Attachments
         If Right(LCase(olAttach.FileName), 4) = "xlsx" Then
             strFilename = strPath & Format(olItem.ReceivedTime, "yyyymmdd-HHMMSS") & _
                           Chr(32) & olAttach.FileName
             olAttach.SaveAsFile strFilename
             On Error Resume Next
             Set xlApp = GetObject(, "Excel.Application")
             If Err <> 0 Then
                 Application.StatusBar = "Please wait while Excel source is opened ... "
                 Set xlApp = CreateObject("Excel.Application")
                 bXStarted = True
             End If
             On Error GoTo 0
             'Open the workbook to read the data
             Set xlWB = xlApp.Workbooks.Open(strFilename)

             For Each xlSheet In xlWB.Worksheets
                If xlSheet.Name = "MySheet1" Then
                    Set xlSheet = xlWB.sheets("MySheet1")
                    Exit For
                End If
             Next

             If xlSheet Is Nothing Then
                Exit Sub
             End If


             If FindValue(strFindText, xlSheet) Then
                olItem.Move myDestFolder

                'MsgBox "Value found in " & strFilename
                 bFound = True
             End If
             xlWB.Close 0
             If bXStarted Then xlApp.Quit
             If Not bFound Then Kill strFilename


             'Exit For
         End If
     Next olAttach
  End If
 End Sub

Answer 4

您可以使用一个简单的函数来检查工作表名称是否存在：

Function CheckIfSheetExists(Sheetname As String, wb As Workbook) As Boolean

On Error Resume Next
Debug.Print wb.Sheets(Sheetname)
If err.Number <> 0 Then CheckIfSheetExists = False Else CheckIfSheetExists = True
err.clear
End Function

你可以这样称呼它

Sub test()
Dim wbook As Workbook
Dim result As Boolean
Set wbook = Workbooks("Book1")

result = CheckIfSheetExists("Sheet4", wbook)
If result = True Then Msgbox "Sheet exists!"
End Sub

---

该函数将尝试打印出指定工作簿中指定工作表的名称。如果失败，则找不到工作表，因此该函数将返回False，否则将返回True。