Geschlossene Datei - Zelle auslesen!

Im Herber Forum gefragt: Eine Exceldatei gleichen Aufbaus ist in verschiedenen Ordnern abgelegt. Alle aber unter einem "Oberordner". Nun soll nach Eingabe des Ordners in Zelle A2 der Inhalt von z. B. D10 aus der jeweiligen Datei ausgelesen werden. Diese soll dabei geschlossen bleiben. Also:

In die Zelle A2 entweder "Test1", "Test2", "Test3" oder "Test4" schreiben!
Klein- Großschreibung ist egal.
Test1-4 sind Ordner - alle unter "Thisworkbook.Path" - in denen jeweils dieselbe Datei ist.
Aus dieser Datei wird eine bestimmte Zelle ausgelesen und in A3 angezeigt
Bei Eingabe eines nicht vorhandenen Ordners erscheint der Datei-Öffnen-Dialog.

Erklärungen auch im Download.

Geschlossene Datei - Zelle auslesen - WorkSheet_Change...[ZIP, 70 KB]

Option Explicit
Const strSheet As String = "Tabelle1" ' Anpassen!!! 
Const strFile As String = "Rapport.xls" ' Anpassen!!! 
Const strCell As String = "D10" ' Anpassen!!! 
'Const strPath As String = "C:\Temp\" ' Anpassen!!! 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim strPath As String
    On Error GoTo Fin
    strPath = ThisWorkbook.Path & "\"
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If Not Intersect(Target, Range("A2")) Is Nothing Then
        If Trim(Target.Value) <> "" Then
            With Me
                .Range("A3").Formula = "='" & strPath & _
                    .Range("A2").Value & "\" & "[" & _
                    strFile & "]" & strSheet & "'!" & strCell
                .Range("A3").Value = .Range("A3").Value
            End With
        Else
            Me.Range("A3").ClearContents
        End If
    End If
Fin:
    Application.EnableEvents = True
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub