How to check if sheets exists in this code

Question

I have set macro for test mails & move them. But if i get an another excel file, where are another sheet names then I get VBA error: subscript out of range.

The error is in this line: 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

How can i test the sheet and if it's not exists then exit sub (errorhandling: exit sub) ?

After you `Set xlSheet = xlWB.sheets("MySheet1")`, you can do a `If Not xlSheet is Nothing then...` . Also move that `on error goto 0` after the `Set`. — FAB, Jun 14 '19 at 08:07
If that linked answer is not enough to give you want you need let me know and I will remove duplicate vote. If shows how to return a boolean which you can use to exit if false and continue if true. Simply add the workbook qualifier. — QHarr, Jun 14 '19 at 08:19

Louis · Accepted Answer · 2019-06-14T08:24:33.760

2

To check if the Sheet exists, you can use a code like this:

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

Hope this helps.

edited Jun 14 '19 at 08:24

answered Jun 14 '19 at 08:12

Louis

3,592
2
10
18

score 1 · Answer 2 · answered Jun 14 '19 at 08:11

You can adjust your code as follows:

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

Simply shift your "On Error GoTo 0" statement after you set your xlSheet value, and then add another "If" statement to check if you should continue with the rest of your code.

score 1 · Answer 3 · answered Jun 14 '19 at 08:12

This should Work for you:

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

score 1 · Answer 4 · answered Jun 14 '19 at 08:14

You could use a simple function to check if a sheet name exits:

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

You can call it like so

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

The function will try to print out the name of the specified worksheet within the specified workbook. If this fails, it could not find the worksheet so the function will return False, otherwise it will return True.

How to check if sheets exists in this code

4 Answers4