MsgBox einbauen - aber wie?

[Westmaster81]

Hallo Zusammen,

ich habe folgenden VBA Code: 

"Public Sub Dokument_öffnen()

 
    Dim strTitel As String
    Dim rngFind As Range
    Dim wksSheet As Worksheet
    Dim blnGefunden As Boolean

         
    'suchdialog kreieren
    strTitel = Worksheets("pivot_tab").Range("B4")
   

    'Schleife über alle Tabellen
    For Each wksSheet In ThisWorkbook.Worksheets

        'zu durchsuchenden spaltenumfang angeben
        Set rngFind = wksSheet.Columns(3).Find(What:=strTitel, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)
               
             
        If Not rngFind Is Nothing Then

            'Hyperlink öffnen
            rngFind.Offset(0, -1).Hyperlinks(1).Follow
           
          'Gefunden-Flag auf True setzen
            blnGefunden = True
         
            'Objekt freigeben
            Set rngFind = Nothing

            'Schleife verlassen
            Exit For
         
        End If
    Next

End Sub"


Die Funktion ist, das wenn das Suchkriterium gefunden worden ist, der Hyperlink links neben dem Suchbegriff geöffnet wird. Der Code funktioniert einwandfrei, jedoch möchte ich noch eine MsgBox einfügen, dass wenn z.B. der Link nicht mehr funktioniert die MsgBox erscheint.

Leider führen meine versuchen mit einer weiteren IF Schleife nicht zum gewünschten Ziel . Ich hoffe ihr könnt mir hierbei helfen?!

Wie bekomme ich die MsgBox rein?

-> das Suchkriterium ist immer findbar (geschlossener Kreislauf)
-> der Link in der Spalte neben dem Suchkriterium kann es eventuell nicht geben.

[UweD]

Hallo

ggf so???

Code:

Option Explicit

Public Sub Dokument_öffnen()


    Dim strTitel As String
    Dim rngFind As Range
    Dim wksSheet As Worksheet
    Dim blnGefunden As Boolean

         
    'suchdialog kreieren
    strTitel = Worksheets("pivot_tab").Range("B4")
   

    'Schleife über alle Tabellen
    For Each wksSheet In ThisWorkbook.Worksheets

        'zu durchsuchenden spaltenumfang angeben
        Set rngFind = wksSheet.Columns(3).Find(What:=strTitel, LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=False)
               
             
        If Not rngFind Is Nothing Then

            'Hyperlink öffnen
           On Error GoTo Ende
           rngFind.Offset(0, -1).Hyperlinks(1).Follow
           
          'Gefunden-Flag auf True setzen
            blnGefunden = True
         
            'Objekt freigeben
            Set rngFind = Nothing

            'Schleife verlassen
            Exit For
         
        End If
    Next
   
    Exit Sub
Ende:
    MsgBox "Fehler Link: " & rngFind.Offset(0, -1).Hyperlinks(1).Address
End Sub

LG UweD

[Westmaster81]

Hallo Uwe,

ich musste die Variable zur MsgBox anpassen, aber sonst passt alles perfekt !

Danke Dir! :)