Attribute VB_Name = "udf_heredoc"
'-------------------------------------------------------------------------------
'File         : udf_heredoc.bas
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki
'Environment  : VBA 2007 +
'Version      : 1.0.1
'Name         : heredoc
'Author       : Stefan Erb (ERS)
'History      : 14.07.2014 - ERS - Creation
'               14.07.2014 - ERS - Kleine Anpassungen
'-------------------------------------------------------------------------------
Option Explicit

'text = <<<TXT
'   Hallo2
'   Welt
'
'TXT;

Private rxText As Object
Private rxRemoveSingleQuotes As Object
Private vbProj As VBProject
Private cache As Object

'/**
' * List ein String aus aus einem Comment aus, der in der heredoc-Syntax steht.
' *
' *     text = heredoc(modulName, name [,clearCache]])
' *
' * @param  String      Name des Moduls
' * @param  String      Name der Variable
' * @param  Boolean     Angabe, ob der Objektcache geleert werden soll
' * @return String      Ausgelesener Text ohne führende '
' */
Public Function heredoc( _
        ByVal iModulName As String, _
        ByVal iName As String, _
        Optional ByVal iClearCache As Boolean = False _
) As String
    Dim key As String: key = iModulName & "#" & iName
    'Cahce anlegen
    If cache Is Nothing Or iClearCache Then
        Set cache = CreateObject("scripting.Dictionary")
    End If
    'Prüfen ob der Text schon mal abgefragt wurde. Wenn ja, aus dem Cache abrufen.
    If cache.exists(key) And Not iClearCache Then
        'Text aus dem Cache laden
        heredoc = cache(key)
        Exit Function
    End If
    
    'Je nach Microsoft-Programm muss das VBProject anderst ausgelesen werden
    If vbProj Is Nothing Or iClearCache Then
        Select Case Application.Name
            Case "Microsoft Access": Set vbProj = Application.VBE.VBProjects(1)
            Case "Microsoft Excel": Set vbProj = ThisWorkbook.VBProject
        End Select
    End If
    Dim vbCodeMod As CodeModule: Set vbCodeMod = vbProj.VBComponents(iModulName).CodeModule
    
    'RegExp anlegen
    'RegExp um eine heredoc-Format aus einem Modul auszulesen
    If rxText Is Nothing Or iClearCache Then
        Set rxText = CreateObject("VBScript.RegExp")
        rxText.pattern = "'" & iName & "\s*=\s*<<<(\w+)([\s\S]*?)[\r\n]\s*'\1;"
        rxText.Global = True
    End If
    'RegExp um die führenden ' zu entfernen
    If rxRemoveSingleQuotes Is Nothing Or iClearCache Then
        Set rxRemoveSingleQuotes = CreateObject("VBScript.RegExp")
        rxRemoveSingleQuotes.pattern = "^\s*'"
        rxRemoveSingleQuotes.Multiline = True
        rxRemoveSingleQuotes.Global = True
    End If
    
    Dim codeText As String: codeText = vbCodeMod.Lines(1, vbCodeMod.CountOfLines)
    If Not rxText.Test(codeText) Then Err.Raise 461     'Method or data member not found
    Dim mc As MatchCollection: Set mc = rxText.Execute(codeText)
    heredoc = rxRemoveSingleQuotes.Replace(mc(0).SubMatches(1), "")
    cache(key) = heredoc
    
Exit_Hanldler:
On Error Resume Next
    Set mc = Nothing
    Set vbCodeMod = Nothing
End Function