Equivalente de INDIRECTO para un archivo cerrado SIN MACROS

'------------------------------------
'Función INDIRECTA extendida v1.0
'------------------------------------
'Copyright (c) 2009 Wilson So.
'Correo electrónico: ***@***
'------------------------------------
'Créditos:
'- Diseñada y escrita por Wilson So.
'- El truco 'CreateObject("Excel.Application")' fue inspirado por el código fuente de la función PULL de Harlan Grove.
'------------------------------------
'Este es un código abierto. Puedes redistribuirlo y modificarlo libremente, pero por favor, da crédito a los contribuidores.
'Por favor, también informa de cualquier error/sugerencia a través del correo electrónico o en los foros donde lo publiqué.
'------------------------------------
'Cómo usar:
'- Básicamente igual que INDIRECTA() en Excel - el mismo concepto para el parámetro ref_text.
'- Para actualizar la memoria estática para una referencia particular,
' escribe VERDADERO en el segundo parámetro (solo uno de los IndirectEx() que contenga esa referencia)
' y cálculalo una vez.
'------------------------------------
'Características:
'- Puedes referirte a datos de libros de trabajo cerrados.
'- Los datos de libros de trabajo cerrados recuperados se almacenarán en la memoria estática,
' así que la próxima vez, el libro de trabajo cerrado no se abrirá nuevamente para una recuperación rápida.
'- Se devolverá un rango en lugar de una matriz si se omite la ruta en ref_text,
' por lo que seguirá funcionando bien si el usuario se refiere a una enorme matriz, por ejemplo, "Hoja1!1:65536".
'- Puedes usarlo dentro de INDICE(), BUSCARV(), COINCIDIR(), etc.
'- Puedes usarlo con DESREF(), pero solo para datos de libros de trabajo abiertos.
'- El procedimiento no recuperará ciegamente todos los datos como se solicita;
' no recuperará datos más allá de la celda "Ctrl + Fin", para mantener la memoria lo más pequeña posible.
'- #NUM! se devolverá en caso de falta de memoria.
'- #REF! se devolverá en caso de una ruta incorrecta.
'- #VALOR! se devolverá en caso de otros errores.
'------------------------------------
'Problemas conocidos:
'- Debido al uso de SpecialCells(), #VALOR! se devolverá si la hoja de trabajo para un libro de trabajo cerrado está protegida.
'------------------------------------

Function IndirectEx(ref_text As String, Optional refresh_memory As Boolean = False) As Variant
 On Error GoTo ClearObject

 Dim RefName As String
 Dim SheetName As String
 Dim WBName As String
 Dim FolderName As String
 
 Dim vExcel As Object
 Dim vWB As Workbook
 
 Static dbOutput() As Variant
 Static dbKey() As String
 Static dbTotalOutput As Integer
 Dim dbIndex As Integer
 
 Dim UserEndRow As Long, UserEndCol As Integer
 Dim RealEndRow As Long, RealEndCol As Integer
 Dim EndRow As Long, EndCol As Integer
 Dim RangeHeight As Long, RangeWidth As Integer
 
 GetNames ref_text, RefName, SheetName, WBName, FolderName
 
 If dbTotalOutput = 0 Then
 ReDim dbOutput(1 To 1) As Variant
 ReDim dbKey(1 To 1) As String
 End If
 
 For i = 1 To dbTotalOutput
 If dbKey(i) = FolderName & WBName & "!" & SheetName & "!" & RefName Then
 dbIndex = i
 End If
 Next
 
 If dbIndex = 0 Or refresh_memory Then
 If dbIndex = 0 Then
 dbTotalOutput = dbTotalOutput + 1
 dbIndex = dbTotalOutput
 ReDim Preserve dbOutput(1 To dbTotalOutput) As Variant
 ReDim Preserve dbKey(1 To dbTotalOutput) As String
 dbKey(dbIndex) = FolderName & WBName & "!" & SheetName & "!" & RefName
 End If
 If FolderName = "" Then
 Set dbOutput(dbIndex) = Workbooks(WBName).Worksheets(SheetName).Range(RefName)
 ElseIf Dir(FolderName & WBName) <> "" Then
 Set vExcel = CreateObject("Excel.Application")
 Set vWB = vExcel.Workbooks.Open(FolderName & WBName)
 With vWB.Sheets(SheetName)
 On Error GoTo ClearObject
 UserEndRow = .Range(RefName).Row + .Range(RefName).Rows.Count - 1
 UserEndCol = .Range(RefName).Column + .Range(RefName).Columns.Count - 1
 RealEndRow = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
 RealEndCol = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
 EndRow = IIf(UserEndRow < RealEndRow, UserEndRow, RealEndRow)
 EndCol = IIf(UserEndCol < RealEndCol, UserEndCol, RealEndCol)
 RangeHeight = EndRow - .Range(RefName).Row + 1
 RangeWidth = EndCol - .Range(RefName).Column + 1
 On Error Resume Next
 dbOutput(dbIndex) = .Range(RefName).Resize(RangeHeight, RangeWidth).Value
 If Err.Number <> 0 Then
 IndirectEx = CVErr(xlErrNum)
 GoTo ClearObject
 End If
 End With
 On Error GoTo ClearObject
 vWB.Close False
 vExcel.Quit
 Set vExcel = Nothing
 Else
 IndirectEx = CVErr(xlErrRef)
 Exit Function
 End If
 End If
 
 If TypeOf dbOutput(dbIndex) Is Range Then
 Set IndirectEx = dbOutput(dbIndex)
 Else
 IndirectEx = dbOutput(dbIndex)
 End If

 Exit Function
 
ClearObject:
 On Error Resume Next
 If Not (vExcel Is Nothing) Then
 vWB.Close False
 vExcel.Quit
 Set vExcel = Nothing
 End If
End Function

Private Sub GetNames(ByVal ref_text As String, ByRef RefName As String, ByRef SheetName As String, ByRef WBName As String, ByRef FolderName As String)
 Dim P_e As Integer
 Dim P_b1 As Integer
 Dim P_b2 As Integer
 Dim P_s As Integer
 
 P_e = InStr(1, ref_text, "!")
 P_b1 = InStr(1, ref_text, "[")
 P_b2 = InStr(1, ref_text, "]")
 P_s = InStr(1, ref_text, ":\")
 
 If P_e = 0 Then
 RefName = ref_text
 Else
 RefName = Right$(ref_text, Len(ref_text) - P_e)
 End If
 RefName = Replace$(RefName, "$", "")
 
 If P_e = 0 Then
 SheetName = Application.Caller.Parent.Name
 ElseIf P_b1 = 0 Then
 SheetName = Left$(ref_text, P_e - 1)
 Else
 SheetName = Mid$(ref_text, P_b2 + 1, P_e - P_b2 - 1)
 End If
 SheetName = Replace$(SheetName, "'", "")
 
 If P_b1 = 0 Then
 WBName = Application.Caller.Parent.Parent.Name
 Else
 WBName = Mid$(ref_text, P_b1 + 1, P_b2 - P_b1 - 1)
 End If
 
 If P_s = 0 Then
 FolderName = ""
 Else
 FolderName = Left$(ref_text, P_b1 - 1)
 End If
 If Left$(FolderName, 1) = "'" Then FolderName = Right$(FolderName, Len(FolderName) - 1)
End Sub