Hallo an Alle,
hier nun wie Versprochen das auslesen des Templatepfads über die dic.CFG
ich habe versucht alle Möglichkeiten abzufangen. Wie immer ist alles in VBA.
Wie immer ist alles im Latebinding. Vorab ein Copy - Paste wird bei niemanden Funktionieren
und ist auch so nicht gewollt das es funktioniert. 
Ich hoffe das Tobit nicht noch einmal auf die Idee kommt den Templatepfade anzurühren. 
Code
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 FunctionGrüßt die Fische
Axel
