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。

如何检查此代码中是否存在工作表

4 个答案: