Email Vorlagen über VBA aus der dic.cfg

Public Function TobitInstalliert(RegRead As String) As Boolean
On Error GoTo Err_End1
Dim wsh As Object, str_olkey As String
Set wsh = CreateObject("WScript.Shell")
str_olkey = "HKEY_CURRENT_USER\Software\Tobit\Tobit InfoCenter\Settings\ProgramDirectory"


'*** Registry auslesen und RegRead für weitere Verwendung füllen! ***
If RegKeyExist(str_olkey) = 0 Then
    RegRead = wsh.RegRead(str_olkey)
    If FNz(RegRead, "") <> "" Then
        Set fs = CreateObject("Scripting.FileSystemObject")
        If fs.FolderExists(RegRead) Then
            TobitInstalliert = True
        End If
    End If
End If


Exit_End1:
    Exit Function
Err_End1:
    Select Case ErrorHandler(""): Case Is = 5: Resume Next: Case Is = 4: Resume: End Select: Resume Exit_End1
    Resume
End Function


-------------------------------------------------------------------------


Public Function TobitTemplateAuslesenCFG() As String()
On Error GoTo Err_End1
Dim str_CFGSuchAnfang As String, str_CFGSuchEnde As String, str_CFGSuchEmailAnfang As String
Dim str_CFGSuchEmailEnde As String, str_CFGSuchStandard As String, str_CFGSelEmail As String, str_CFGSuchUndefiniert As String
Dim str_CFGInhalt As String, int_CFGTemplateFNStart As Integer, int_CFGTemplateFNLaenge As Integer, str_TobitPath As String
Dim str_TemplateFile() As String, str_Ausgabe() As String, i As Integer, j As Integer, int_CFGTemplateFNEMailStart As Integer, str_CFGPfad As String
Dim obj_App As Object
Dim obj_Account As Object
Dim obj_UserArchive As Object


'*** prüfen ob Tobit installiert und Rückgabe Pfad! ***
If TobitInstalliert(str_TobitPath) = 0 Then Exit Function


'*** erstellen der Objekte ***
Set obj_App = CreateObject("DVOBJAPILib.DvISEAPI")
Set obj_Account = obj_App.Logon("", "", "", "", "", "AUTH")
Set obj_UserArchive = obj_Account.GetSpecialArchive(100) 'Konstante "100" gibt Persönliches Archiv das die dic.cfg beinhaltet an!


str_CFGPfad = obj_UserArchive.ID & "\dic.cfg"


str_CFGInhalt = Dateiöffnen(str_CFGPfad) 'öffnet die Datei und ließt diese als Binary ein
str_CFGSuchAnfang = "TemplateFN" & Chr(0)
str_CFGSuchEnde = Chr(0)
str_CFGSuchEmailAnfang = Chr(33)
str_CFGSuchEmailEnde = Chr(45)
str_CFGSuchStandard = Chr(11)
str_CFGSuchUndefiniert = Chr(12)
i = 0
Do While str_CFGInhalt <> ""
    int_CFGTemplateFNStart = InStr(str_CFGInhalt, str_CFGSuchAnfang) + Len(str_CFGSuchAnfang)
    If int_CFGTemplateFNStart < 1 Then Exit Function
    int_CFGTemplateFNLaenge = InStr(int_CFGTemplateFNStart, str_CFGInhalt, str_CFGSuchEnde) - int_CFGTemplateFNStart
    ReDim Preserve str_TemplateFile(2, i)
    str_CFGSelEmail = Right(Left(str_CFGInhalt, InStr(str_CFGInhalt, str_CFGSuchAnfang) - 1), 2)
    Select Case Right(str_CFGSelEmail, 1)
        Case str_CFGSuchStandard
            str_TemplateFile(0, i) = "Standard"
        Case str_CFGSuchEmailEnde
            Select Case Left(str_CFGSelEmail, 1)
                Case str_CFGSuchUndefiniert
                    str_TemplateFile(0, i) = "Undefiniert"
                Case Else
                    int_CFGTemplateFNEMailStart = InStrRev(Left(str_CFGInhalt, int_CFGTemplateFNStart), str_CFGSuchEmailAnfang) '
                    str_TemplateFile(0, i) = Mid(str_CFGInhalt, int_CFGTemplateFNEMailStart + Len(str_CFGSuchEmailAnfang), int_CFGTemplateFNStart - (int_CFGTemplateFNEMailStart + Len(str_CFGSuchAnfang) + 1 + Len(str_CFGSuchEmailEnde)))
            End Select
        Case Else
            str_TemplateFile(0, i) = "Undefiniert"
    End Select
    str_TemplateFile(1, i) = Mid(str_CFGInhalt, int_CFGTemplateFNStart, int_CFGTemplateFNLaenge)
    If fs.FileExists(str_TemplateFile(1, i)) Then
            str_TemplateFile(2, i) = True
        Else
            str_TemplateFile(2, i) = False
    End If
    If InStr(int_CFGTemplateFNStart + int_CFGTemplateFNLaenge, str_CFGInhalt, str_CFGSuchAnfang) = 0 Then
            str_CFGInhalt = ""
        Else
            str_CFGInhalt = Right(str_CFGInhalt, Len(str_CFGInhalt) - int_CFGTemplateFNStart)
    End If
    i = i + 1
Loop
j = 0
For i = 0 To UBound(str_TemplateFile, 2)
    If str_TemplateFile(2, i) = True Then
        ReDim Preserve str_Ausgabe(j)
        str_Ausgabe(j) = str_TemplateFile(1, i) & ";" & str_TemplateFile(0, i) & "; Tobit;"
        j = j + 1
    End If
Next i


TobitTemplateAuslesenCFG = str_Ausgabe


Exit_End1:
    Exit Function
Err_End1:
    Select Case ErrorHandler(""): Case Is = 5: Resume Next: Case Is = 4: Resume: End Select: Resume Exit_End1
    Resume
End Function