VBA - Check if a sheet exists then import in my workbook else show an error message-CodePudding

i'm having a bit of a headache with VBA which i haven't used since 2006.

I have my destination excel file where I need to import 3 predefined sheets from another excel file of the user's choice.

After selecting the source file to import I would like to perform a check, IF the "Cover" sheet exists THEN copy it to the target workbook ELSE print an error message in the excel file in order to have a log, once this is done I have to do the same check for the "Functional" and "Batch" sheets.

Before inserting the IFs, I was able to import the sheets but I didn't have control over whether they existed or not, "Cover" is mandatory while "Functional" and "Batch" I need at least one of the two to be able to proceed with the next steps.

Now I can check if the "Cover" sheet exists and import it ELSE I exit the Sub, after which I should check if the other sheets also exist and import them but I immediately get the "absent sheet" error.

Below is the code I am getting stuck with:

Sub Import()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim TargetWorkbook As Workbook
    Dim SourceWorkbook As Workbook
    Dim OpenFileName

    Set TargetWorestBookkbook = ActiveWorkbook


    'Select and Open Source workbook
    OpenFileName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")
        
    If OpenFileName = False Then
        MsgBox "Nessun file Source selezionato. Impossibile procedere."
        Exit Sub
    End If
        
    On Error GoTo exit_
    
    Set SourceWorkbook = Workbooks.Open(OpenFileName)
    
    'Import sheets
    ' if the sheet doesn't exist an error will occur here

        If WorksheetExists("Cover e Legenda") Then
            SourceWorkbook.Sheets("Cover e Legenda").Copy _
            after:=TargetWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            Application.CutCopyMode = False
            SourceWorkbook.Close False
        Else
            MsgBox ("Cover assente. Impossibile proseguire.")
            Exit Sub
        End If

        If WorksheetExists("Test Funzionali") Then
            SourceWorkbook.Sheets("Test Funzionali").Copy _
            after:=TargetWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            Application.CutCopyMode = False
            SourceWorkbook.Close False
        Else
            MsgBox ("Test Funzionali assente.")
        End If

        If WorksheetExists("Test Batch") Then
            SourceWorkbook.Sheets("Test Batch").Copy _
            after:=TargetWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            Application.CutCopyMode = False
            SourceWorkbook.Close False
        Else
            MsgBox ("Test Batch assente.")
        End If

    'Next Sheet
            
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
            
    SourceWorkbook.Close SaveChanges:=False
    MsgBox ("Importazione completata.")

    TargetWorkbook.Activate
        
        
exit_:
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        If Err Then MsgBox Err.Description, vbCritical, "Error"


End Sub

CodePudding user response：

Best to check all of the sheets before importing any of them.

Try something like this:

Sub Import()

    Dim wbTarget As Workbook, wbSource As Workbook
    Dim OpenFileName, haveCover As Boolean, haveFunz As Boolean, haveTest As Boolean

    On Error GoTo haveError
    
    Set wbTarget = ActiveWorkbook

    'Select and Open Source workbook
    OpenFileName = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")
    If OpenFileName = False Then
        MsgBox "Nessun file Source selezionato. Impossibile procedere."
        Exit Sub
    End If
        
    Set wbSource = Workbooks.Open(OpenFileName)
    
    'check which sheets exist
    haveCover = WorksheetExists(wbSource, "Cover e Legenda")
    haveFunz = WorksheetExists(wbSource, "Test Funzionali")
    haveTest = WorksheetExists(wbSource, "Test Batch")
    
    If haveCover And (haveFunz Or haveTest) Then 'have the minumum required sheets?
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        ImportSheet wbTarget, wbSource.Worksheets("Cover e Legenda")
        If haveFunz Then ImportSheet wbTarget, wbSource.Worksheets("Test Funzionali")
        If haveTest Then ImportSheet wbTarget, wbSource.Worksheets("Test Batch")
        Application.DisplayAlerts = True
    Else
        MsgBox "Required sheet(s) not found!", vbExclamation
    End If
    
    wbSource.Close SaveChanges:=False
    MsgBox "Importazione completata"
    wbTarget.Activate
    Exit Sub 'normal exit
    
haveError:
    MsgBox Err.Description, vbCritical, "Error"
    Application.DisplayAlerts = True
    
End Sub

'copy sheet `ws` to the end of `wbTarget`
Sub ImportSheet(wbTarget As Workbook, ws As Worksheet)
    ws.Copy after:=wbTarget.Worksheets(wbTarget.Worksheets.Count)
End Sub

'does sheet `wsName` exist in workbook `wb` ?
Function WorksheetExists(wb As Workbook, wsName As String) As Boolean
    On Error Resume Next
    WorksheetExists = Not wb.Worksheets(wsName) Is Nothing
End Function

CodePudding user response：

Import Mandatory and Optional Worksheets

Sub ImportWorksheets()
    
    Dim Mandatory() As Variant: Mandatory = VBA.Array("Cover e Legenda")
    Dim Optionally() As Variant ' 'Optional' is a keyword
    Optionally = VBA.Array("Test Funzionali", "Test Batch")
    
    Dim twb As Workbook: Set twb = ThisWorkbook ' workbook containing this code
    
    ' Select and open the Source workbook.

    Dim OpenFilePath As Variant
    OpenFilePath = Application.GetOpenFilename("Excel Files (*.xls*),*.xls*")

    If OpenFilePath = False Then
        MsgBox "Nessun file Source selezionato. Impossibile procedere.", _
            vbExclamation
        Exit Sub
    End If
        
    Dim swb As Workbook: Set swb = Workbooks.Open(OpenFilePath)
    
    ' Check if all the mandatory worksheets exist.
        
    Dim sws As Worksheet, n As Long
    
    For n = 0 To UBound(Mandatory)
        On Error Resume Next ' prevent error if worksheet doesn't exist
            Set sws = swb.Worksheets(Mandatory(n))
        On Error GoTo 0
        If sws Is Nothing Then
            'swb.Close SaveChanges:=False
            MsgBox "The mandatory worksheet """ & Mandatory(n) _
                & """ was not found in """ & swb.Name & """.", vbCritical
            Exit Sub
        Else
            Set sws = Nothing
        End If
    Next n
    
    ' Check if at least one of the optional worksheets exists.
    
    Dim oDict As Object: Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = vbTextCompare
    
    For n = 0 To UBound(Optionally)
        On Error Resume Next ' prevent error if worksheet doesn't exist
            Set sws = swb.Worksheets(Optionally(n))
        On Error GoTo 0
        If Not sws Is Nothing Then oDict(sws.Name) = Empty: Set sws = Nothing
    Next n
    
    If oDict.Count = 0 Then
        'swb.Close SaveChanges:=False
        MsgBox "No optional worksheets found in """ & swb.Name & """.", _
            vbCritical
        Exit Sub
    End If
    
    ' Import the worksheets and close the Source workbook.
    
    Application.ScreenUpdating = False

        For n = 0 To UBound(Mandatory)
            swb.Sheets(Mandatory(n)).Copy After:=twb.Sheets(twb.Sheets.Count)
        Next n
        
        Dim oKey As Variant
        
        For Each oKey In oDict.Keys
            swb.Sheets(oKey).Copy After:=twb.Sheets(twb.Sheets.Count)
        Next oKey

        swb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    
    ' Inform.
    
    MsgBox "Imported Worksheets" & vbLf & vbLf _
        & "Mandatory:" & vbLf & Join(Mandatory, vbLf) & vbLf & vbLf _
        & "Optionally:" & vbLf & Join(oDict.Keys, vbLf), vbInformation
    
End Sub