PDA

Vollständige Version anzeigen : Variable Quelle zum laden einer Vorlage


jack_D
27.09.2016, 15:31
Hallo Gemeinde,

Ich mal wieder :p

Ich hab eine Frage die zwar eigentlich zu Powerpoint gehört,
aber
1. Dieser Forumsteil etwas weniger stark frequentiert ist
UND
2. (imho) auch für Excel relevanz hat.

Sub PraeseNeuVorlage(ByVal control As IRibbonControl)
Dim FileName As String

FileName = "Muster.potm"
Presentations.Open "C:\Users\Name\AppData\Roaming\Microsoft\Templates\" + FileName, untitled:=msoCTrue
End Sub

Vorgenannte Code erstellt mir eine Neue Präsentation und zieht sich eine Vorlage (die er dann auch anwendet) - funktioniert auch super soweit.

Nun möchte ich dieses Addin anderen zur Verfügung stellen.
Dazu benötigen sie natürlich einmal die Vorlage und das Addin soweit so klar.

Doch Arbeiten alle mit verschiedenen Betriebssystemen (Win 7 - Win 10)
Ich befürchte das damit der Speicherpfad sich bei allen etwas unterscheidet ..?
Der Namensteil "Name" ja sowieso .. aber den würd ich mir über "enviroment" holen - muss gleich mal schauen ob der Befehl unter pptx zur Verfügung steht.

WIe kann ich aber nun den Restlichen Speicherort "variabilisieren" ?

Vielen Dank für eure Ideen und Vorschläge

Jack

R J
27.09.2016, 16:28
Hi Jack,

Ich befürchte das damit der Speicherpfad sich bei allen etwas unterscheidet ..?
Der Namensteil "Name" ja sowieso

Weshalb denn der Name? Schlimmstenfalls die Extension...


das Betriebssystem ist für den Namen der Vorlage unwesentlich. Wesentlich ist die Officeversion. Die entscheidet ob Du oder der User *.pot (bis 2003) oder *.potx oder *.potm (ab 2007) verwenden kann.

Wenn Du die Vorlage zentral auf einem Server ablegst, im gleichen Verzeichnis wie die Vorlagen dann brauchst Du doch nur checken, welche Officeversion verwendet wird und dann entsprechend die passende Vorlage anbieten.

Falls die Vorlagen lokal gespeichert werden, werden sie standardmäßig unter
C:\Users\Username\Documents\Benutzerdefinierte Office-Vorlagen
abgelegt. Wenn das gewährleistet werden kann, dann hast Du auch weiter keine Probleme.

jack_D
27.09.2016, 16:56
Hallo Ralf,

vielen Dank für deinen Beitrag.

Weshalb denn der Name? Schlimmstenfalls die Extension... & Falls die Vorlagen lokal gespeichert werden, werden sie standardmäßig unter
C:\Users\Username\Documents\Benutzerdefinierte Office-Vorlagen

Genau das ist die Ursache. Die Vorlagen sollen Lokal abgespeichert werden, da die Laptops auch ohne unseren Server diese Funktionalität nutzen können sollen.
- Heimarbeit -

Und deswegen auch der Name:
Der ist natürlich bei jedem anders das lässt sich aber über Environ(2) ganz gut lösen.

Die Sache ist allerdings die, dass meine Vorlagen unter
"C:\Users\Name\AppData\Roaming\Microsoft\Templates\"
abgelegt werden.

Bei meinem einen Kollegen wo ich vorhin mal kurz geschaut hab ist dann aber das Ende "Microsoft\Templates\" anders (Win 8; Office 2013 glaub ich.)

Kann aber sein, dass ich mich einfach verguggt hab ..
Muss ich morgen nochmal machen, wenn ich im Büro bin..

Die Erweiterungsthematik ist mir bekannt, daher hab ich mittlerweile die "kleinste" genommen. *. pot (Beim OT war es noch eine potm)
Damit sollte das Problem imho ja nicht auftreten.

Beste Grüße

R J
27.09.2016, 20:08
...hach... Microsoft....;)

Wenn die Pfade also von Windowsversion zu Windowsversion unterschiedlich sind, dann könnte man ja den Templatepfad aud der Registry lesen. Bei mir steht er in:
HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\15.0\Word\Options\PersonalTemplates

Die 15.0 steht für die Officeversion (15 = Office 2013). Die bekommst Du über : Application.Version
heraus.

Ob nun Word, Excel oder PP ist ja egal, der Pfad bleibt gleich.

Und hier die gesamte Routine dazu

Sub LiesRegistry()

Dim vers$
Dim RegKey As String
Dim Wert As String

vers = Application.Version
RegKey = "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & vers & "\Word\Options\PersonalTemplates"
If RegKey = "" Then Exit Sub
If RegKeyExists(RegKey) = True Then
Wert = RegKeyRead(RegKey)
Else
MsgBox "Der Registrierungsschlüssel """ & RegKey & _
""" wurde nicht gefunden."
End If
End Sub

Function RegKeyRead(i_RegKey As String) As String
Dim myWS As Object

On Error Resume Next
Set myWS = CreateObject("WScript.Shell")
RegKeyRead = myWS.RegRead(i_RegKey)
End Function

Function RegKeyExists(i_RegKey As String) As Boolean
Dim myWS As Object

On Error GoTo ErrorHandler
Set myWS = CreateObject("WScript.Shell")
myWS.RegRead i_RegKey
RegKeyExists = True
Exit Function

ErrorHandler:
RegKeyExists = False
End Function

jack_D
27.09.2016, 22:36
Hallo Ralf,

vielen Lieben Dank für deinen Code.
Ich schau ihn mir morgen im Office an.. der Code würde mein Mac wohl eher zum Rauchen bringen :grins: :grins: :grins:

Ich meld mich morgen, wenn ich ihn testen konnte.

Besten Dank einstweilen!

Jack

R J
28.09.2016, 09:42
beim Mac kann ich Dir auch nicht sagen, wie das intern organisiert ist. Hatte nie einen. Application.Version funktioniert zwar dennoch, da das ja eine Office Funktion ist, aber wo beim Mac der Speicherort für Templates hinterlegt ist... keine Ahnung...

Zumindest könntest Du vorher das Betriebssystem ermitteln. Und wenn es eben Mac ist, dann die Routine verlassen (wenn Du nicht weißt wo Apple den Pfad speichert) oder, falls Du es doch weißt, dann mit einer separaten Routine darauf reagieren.
Hier der Code zum ermitteln des BS.:

Option Explicit

Private Declare Function GetVersionEx Lib "kernel32" Alias _
"GetVersionExA" (lpVersionInformation As OSVERSIONINFO) _
As Long

Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2

Sub BSTest()
Dim w$
if MacOrWin = "Mac" then
Msgbox "Keine Ahnung wo Apple den Pfad für Templates abgelegt hat...."
exit Sub
else
LiesRegistry
end if
End Sub

Function MacOrWin() As String
Dim vers$
#If Mac Then
vers = "Mac"
#Else
vers = "Windows"
#End If
MacOrWin = IIf(vers = "Windows", GetWinPlatform, vers)
End Function

Public Function GetWinPlatform() As String
Dim strPlatForm As String
Dim osvi As OSVERSIONINFO

osvi.dwOSVersionInfoSize = Len(osvi)
GetVersionEx osvi

strPlatForm = "Unbekanntes Betriebssystem"
With osvi
If .dwPlatformId = VER_PLATFORM_WIN32_WINDOWS Then
If .dwMinorVersion = 0 Then
strPlatForm = "Windows 95"
If .szCSDVersion = "B" Then
strPlatForm = strPlatForm & " OSR2"
Else
strPlatForm = strPlatForm & Left$(.szCSDVersion, 2)
End If
ElseIf .dwMinorVersion = 10 Then
strPlatForm = "Windows 98"
If .szCSDVersion = "A" Then
strPlatForm = strPlatForm & " SE"
End If
ElseIf .dwMinorVersion = 90 Then
strPlatForm = "Windows ME"
Else
strPlatForm = "Win 32s"
End If
ElseIf .dwPlatformId = VER_PLATFORM_WIN32_NT Then
If .dwMajorVersion = 4 Then
strPlatForm = "Windows NT"
ElseIf .dwMajorVersion = 5 Then
If .dwBuildNumber = "2195" Then
strPlatForm = "Windows 2000"
ElseIf .dwBuildNumber = "2600" Then
strPlatForm = "Windows XP"
End If
ElseIf .dwMajorVersion = 7 Then
strPlatForm = "Windows 7"
ElseIf .dwMajorVersion = 8 Then
strPlatForm = "Windows 8"

ElseIf .dwMajorVersion = 10 Then
strPlatForm = "Windows 10"
End If
End If
End With

GetWinPlatform = strPlatForm
End Function


Ich kann aber nicht garantieren, dass das zu 100% funktioniert, deshalb am Besten mal im Einzelschrittmodus durchlaufen. Das Ergebnis für den Mac würde mich aber auch interessieren.

jack_D
28.09.2016, 09:52
Hallo Ralf,

Ich kann es drehen und senden wie ich will...
der findet den RegKey nicht ..
hab auch schonmal den Pfad auf PPT adjustiert. Ergebnislos

Ich hab auch mal in der Registry geschaut bei mir heisst das nicht PersonalTemplates sondern RecentTemplates ..

???

Beste Grüße

haklesoft
28.09.2016, 09:59
Hallo Ralf,

GetVersionEx liefert unter Windows maximal 6.2.9200 (= Windows 8), scheitert also bei neuen Betriebssystemen. Lösung: WMI.

R J
28.09.2016, 10:11
@ Jack,
Ich hab auch mal in der Registry geschaut bei mir heisst das nicht PersonalTemplates sondern RecentTemplates

Dann eine entsprechende Verzweigung mit RecentTemplates einbauen, für den Fall das PersonalTemplates nicht gefunden wird.

Probiere mal folgendes:
Versuche mal eine Präsentation als Template zu speichern (musst Du ja nicht bestätigen). Aber sobald Du als Typ eine Vorlage auswählst, wechselt die Dialogbox sofort in das Vorlagenverzeichnis (automatisch). Kopiere diesen Pfad und lass in der Registry danach suchen....

@ Haklesoft,
GetVersionEx liefert unter Windows maximal 6.2.9200 (= Windows 8), scheitert also bei neuen Betriebssystemen

kann ich nicht bestätigen. Ich hab Windows 10 und er liefert mir genau das...

haklesoft
28.09.2016, 10:34
@Ralf

Dann hast Du eine Manifestdatei (https://msdn.microsoft.com/en-us/library/dn481241(v=vs.85).aspx) integriert. Ich aber nicht.

R J
28.09.2016, 11:03
@Haklesoft,

ah! Gut zu wissen! Danke für den Hinweis!

Aber dann wollen wir Jack die WMI Version nicht vorenthalten....;)


Sub test()
MsgBox LiesWindowsBS
End Sub

Function LiesWindowsBS() As String
Dim oWMI As Object
Dim oSystem As Object
Dim SQL As String
Dim str$, vers$

' Abfrage
SQL = "SELECT * FROM Win32_OperatingSystem"

' WMI-Objekt erstellen und Abfrage ausführen
Set oWMI = GetObject("winmgmts:").ExecQuery(SQL)

' Ergebnisliste durchlaufen und Infos ausgeben
For Each oSystem In oWMI
str = str & "System:" & vbTab & oSystem.Caption
vers = oSystem.Caption
' Versionsnummer
str = str & vbCrLf & "Versionsnummer: " & vbTab & oSystem.Version

' ServicePack
str = str & vbCrLf & "Servicepack;" & vbTab & oSystem.CSDVersion

' UserName
str = str & vbCrLf & "Username: " & vbTab & oSystem.RegisteredUser

' Firma
str = str & vbCrLf & "Firma:" & vbTab & oSystem.Organization

' Seriennummer
str = str & vbCrLf & "Seriennummer:" & vbTab & oSystem.SerialNumber

' Systemverzeichnis
str = str & vbCrLf & "System Verzeichnis: " & oSystem.SystemDirectory

' Windowsverzeichnis
str = str & vbCrLf & "Windows Verzeichnis: " & oSystem.WindowsDirectory

' Arbeitsspeicher
str = str & vbCrLf & "Arbeitsspeicher: " & oSystem.TotalVisibleMemorySize & " KByte"
Next
'MsgBox str
'wir brauchen aber nur die Windowsversion, deshalb:
LiesWindowsBS = vers
End Function

haklesoft
28.09.2016, 11:41
Aber dann wollen wir Jack die WMI Version nicht vorenthalten....;)Natürlich nicht! Hier ist eine weitere Variante:Option Explicit

'---------------------------------------------------------------------------------------
' Procedure : getOperatingSystem
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the active OS details
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' ******************************************************************************** ******
' 1 2012-Sep-27 Initial Release
'---------------------------------------------------------------------------------------
' Modifiziert durch MOF\haklesoft 24. 8. 2015 / 28. 9. 2016
' Infos aus https://msdn.microsoft.com/en-us/library/aa394596%28v=vs.85%29.aspx?cs-save-lang=1&cs-lang=vb#code-snippet-1

Dim localHost As String
Dim objWMIService As Variant
Dim colOperatingSystems As Variant
Dim objOperatingSystem As Variant

Public Function getOperatingSystem() As String
On Error GoTo Error_Handler

localHost = "." 'Technically could be run against remote computers, if allowed
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & localHost & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

For Each objOperatingSystem In colOperatingSystems
' Rückgabe von Name und Version
getOperatingSystem = objOperatingSystem.Caption & " " & objOperatingSystem.Version

' Exit Function '<=== auskommentiert für zusätzliche Ausgabe der Langform im Direktfenster

Debug.Print "Betriebssystem: ", objOperatingSystem.Caption & " " & objOperatingSystem.Version
Debug.Print "Service-Pack: ", objOperatingSystem.ServicePackMajorVersion & "." & objOperatingSystem.ServicePackMinorVersion
Debug.Print "Install Date: ", objOperatingSystem.InstallDate
Debug.Print "Windows Folder: ", objOperatingSystem.WindowsDirectory
Next

'Hier entsteht eine gewisse Wartezeit, deshalb vielleicht auslagern und in optionaler Routine ausgeben lassen?
Dim colQuickFixes, objQuickFix
Set colQuickFixes = objWMIService.ExecQuery("Select * from Win32_QuickFixEngineering")
Debug.Print "Updates: ", , colQuickFixes.Count
For Each objQuickFix In colQuickFixes
If objQuickFix.Description = "Security Update" Then
Debug.Print objQuickFix.Description, objQuickFix.HotFixID, Format(objQuickFix.InstalledOn, "dd.mm.yyyy")
Else
Debug.Print objQuickFix.Description, , objQuickFix.HotFixID, Format(objQuickFix.InstalledOn, "dd.mm.yyyy")
End If
Next

Error_Handler_Exit:
On Error Resume Next
Exit Function

Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: getOperatingSystem" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function

jack_D
28.09.2016, 12:14
Hallo Ihr beiden

vielen Dank für eure Beiträge.
Die BS versionen auslesen klappt klaglos.
Die Krux ist jetzt allerdings die Pfade zu finden.(Template-Pfade)

Zum thema funktionalität auf dem Mac.. Werde ich testen und berichten.

Beste Grüße

jack_D
28.09.2016, 12:28
Zum Thema Mac -- Auch wenn es nur eine Randbetrachtung ist, da es auf denen nicht implementiert werden soll

Der Code steigt in der function :
Public Function GetWinPlatform() As String
bei
GetVersionEx osvi
mit dem

LFZ 53 "Datei wurde nicht gefunden. kernel32
aus

Beste Grüße

R J
28.09.2016, 12:55
LFZ 53 "Datei wurde nicht gefunden. kernel32

....smile... war irgendwie zu erwarten. Wäre ja auch zu schön, wenn Apple und MS identische Funktionsnamen verwenden würden....:D

Aber... nun wissen wir das und können somit den Fehler abfangen und entsprechend darauf reagieren...:)

Die Krux ist jetzt allerdings die Pfade zu finden.(Template-Pfade)


Hattest Du mal versucht eine Vorlage zu speichern und den vorgeschlagenen Pfad zu kopieren und in Regedit zu suchen?

jack_D
28.09.2016, 13:31
Hallo Ralf,
....smile... war irgendwie zu erwarten. Wäre ja auch zu schön, wenn Apple und MS identische Funktionsnamen verwenden würden....

:p Kann man nicht erwarten. Gibt da einiges was man bei der Programmierung auf beiden System beachten muss. Ich glaub zb dictionarys gehen auch nicht.
Aber egal =)


Hattest Du mal versucht eine Vorlage zu speichern und den vorgeschlagenen Pfad zu kopieren und in Regedit zu suchen?
Hat er =)
Und auch die Pfade meiner Kollegen. Dabei hat sich herausgestellt das
Wir nur WIN 7 und WIN10 haben
HIer sind die Pfade

'C:\Users\Name\AppData\Roaming\Microsoft\Templates (Win7)
'C:\Users\Name\Documents\Benutzerdefinierte Office-Vorlagen (WIN10)

Ich werd es jetzt ganz stumpf über Select Case machen.
BS abfragen
wenn 7er dann Pfad 1
wenn 10er dann Pfad 2


Frage an der Stelle kann ich unproblematisch die WIN Versionen unterscheiden (Aktuell versuch ich die nummer aus "Microsoft Windows 7 Professional" zu extrahieren (Analog dann bei WIN 10)

Beste GRüße und Danke für deine Hilfe!

Jack

haklesoft
28.09.2016, 15:41
Hallo Jack,

RecentTemplates stellt auf zuletzt benutzte Vorlagen ab, wenn es denn sowas geben würde, taugt also nicht.

In den Options würde ich auch nicht mehr nach einem Vorlagenpfad suchen. Eher in Einstellungen, Sicherheitscenter, Vertrauenswürdige Speicherorte.
Entsprechend in der Registry "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & OfficeVersion & "\PowerPoint\Security\Trusted Locatios\Location0", "Path".

Bei mir steht da: %APPDATA%\Microsoft\Templates.

Das kannst Du dann auch in Powerpoint auflösen:' Die Officeversion bekommst Du in Powerpoint mit
Application.Version

' Und den Inhalt von AppData zeigt Dir
Environ("Appdata")Eine Betriebssystemunterscheidung ist also nicht erforderlich.

jack_D
29.09.2016, 10:19
Hallo Haklesoft,

danke für deinen Rat .

Ich hab mir Environ("Appdata") mal angeschaut,
das bringt (sowohl auf WIN 7 und office 14.0 als auch auf WIN10 office 15.0)

" ... \AppData\Roaming"

Das ist ja aber nicht der VorlagenOrdner .. ?

Beste Grüße

haklesoft
29.09.2016, 10:41
Hallo Jack,

Du musst auch noch den Rest berücksichtigen von Bei mir steht da: %APPDATA%\Microsoft\Templates

jack_D
29.09.2016, 11:12
Hallo Haklesoft

Bei mir gibt Environ("Appdata") nur" ... \AppData\Roaming"" zurück ..?

Grüße Jack

haklesoft
29.09.2016, 12:01
Ich zitiere mich nochmal selber:... in der Registry "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & OfficeVersion & "\PowerPoint\Security\Trusted Locatios\Location0", "Path".

Bei mir steht da: %APPDATA%\Microsoft\Templates.

jack_D
29.09.2016, 12:28
Okay..

Das hab ich dann geflissentlich überlesen :rolleyes:
Sorry..

Ich hab mir indes eine Krücke gebaut
Sub PraeseNeu(ByVal control As IRibbonControl)
Dim FileName As String

FileName = "Muster.potx"
Select Case getZahl(LiesWindowsBS)
Case Is = 7
STRENDE = "\AppData\Roaming\Microsoft\Templates\"
Case Is = 10
STRENDE = "\Documents\Benutzerdefinierte Office-Vorlagen\"
End Select


Presentations.Open Right(Environ$(11), Len(Environ$(11)) - InStr(Environ$(11), "=")) & STRENDE & FileName, untitled:=msoCTrue
End Sub

Das funktioniert auch soweit.
Allerdings musste ich auf einem WIN10 Rechner (update aus 8er Win)
Es noch etwas anpassen, da (mir unverständlich) der verweis auf den Nutzer nicht unter environ(11) sondern unter environ(13) zu finden ist.

ALso SO:
Sub PraeseNeu(ByVal control As IRibbonControl)
Dim FileName As String

FileName = "Muster.potx"
Select Case getZahl(LiesWindowsBS)
Case Is = 7
strbeginn = Right(Environ$(11), Len(Environ$(11)) - InStr(Environ$(11), "="))
STRENDE = "\AppData\Roaming\Microsoft\Templates\"
Case Is = 10
strbeginn = "C:\" & Right(Environ$(13), Len(Environ$(13)) - InStr(Environ$(13), "="))
STRENDE = "\Documents\Benutzerdefinierte Office-Vorlagen\"
End Select


Presentations.Open strbeginn & STRENDE & FileName ', untitled:=msoCTrue

End Sub

Beste Grüße

haklesoft
29.09.2016, 12:59
Auf die Reihenfolge der Environ-Einträge kannst Du Dich nicht verlassen! :boah:

Ich mach morgen mal ein Codebeispiel, da ich heute nicht am PC bin.

jack_D
29.09.2016, 13:43
Auf die Reihenfolge der Environ-Einträge kannst Du Dich nicht verlassen!


Ernsthaft...? Microsoft...:rolleyes: :rolleyes: :rolleyes:

Nichts ist so beständig wie die Veränderung :-D

Ich mach morgen mal ein Codebeispiel, da ich heute nicht am PC bin.

Okay.. Vielen Dank

Beste Grüße

haklesoft
30.09.2016, 12:01
Auf die Reihenfolge der Environ-Einträge kannst Du Dich nicht verlassen!

Ernsthaft...? Microsoft...:rolleyes: :rolleyes: :rolleyes:

Nichts ist so beständig wie die Veränderung :-D Das siehst Du wohl nicht richtig. Die Settings werden seit uralten DOS-Zeiten während des Startvorganges eingetragen, wobei es noch nie eine Rolle gespielt hat, in welcher Reihenfolge dies erfolgt. Da kann man mit .bat, .sys und Programmen auch selbst eingreifen.

Hier noch das versprochene Beispiel:Option Explicit

' Mit diesem Modul-Code wird der Ablagepfad zu Powerpoint-Vorlagen des aktuellen Users ermittelt.
' Der Code funktioniert nur dann, wenn im normal installierten Office-Paket vom User keine Verschiebungen
' bei den vertrauenswürdigen Speicherorten vorgenommen wurden, Location0 also auf den Vorlagenpfad zeigt.
' Das ist ab Office 2007 unverändert der Fall.

' Entwicklung und Stand: MOF\haklesoft, 30.09.2016
' Obwohl Registryinhalte natürlich mit Hilfe von API-Funktionen oder wie von MOF\R J (Ralf) gezeigt per Script lesbar sind,
' nutze ich hier die Tatsache, dass Microsoft-Word mit seinem System-Objekt auch auf Registryinhalte zugreifen kann.

Public Function getTemplatePath() As String
Dim appWord As Object
Dim sRegEintrag As String, sRegPath As String, sFullPath As String
Dim sOffVers As String
Dim lPos As Long

sOffVers = Application.Version 'Officeversion ermitteln

' Eintrag per Word.System aus Registry lesen
Set appWord = CreateObject("Word.Application")
sRegEintrag = appWord.System.PrivateProfileString("", "HKEY_CURRENT_USER\SOFTWARE\Microsoft\Office\" & sOffVers & _
"\PowerPoint\Security\Trusted Locations\Location0", "Path")
appWord.Quit
Set appWord = Nothing

' Setting auslesen, Pfad zusammenbauen
lPos = InStrRev(sRegEintrag, "%")
If lPos > 0 Then
sRegPath = Mid(sRegEintrag, lPos + 1) ' hinterer Abschnitt
sFullPath = Environ(Mid$(sRegEintrag, 2, lPos - 2)) & sRegPath
Else
sFullPath = sRegEintrag 'nur hilfsweise
End If

' Ergebnis liefern, sofern Verzeichnis existiert
If Dir(sFullPath, vbDirectory) <> "" Then
' MsgBox sFullPath ' aktivieren falls gewünscht
getTemplatePath = sFullPath
End If

End Function

jack_D
30.09.2016, 12:22
Hallo Haklesoft,

vielen Dank für deinen Code.
Erwartungsgemäß funktioniert der Klaglos ;-D
Ich kann ihn allerdings nur grad an meinem PC testen.
Am Dienstag kommt dann der kreuztest =)

Das siehst Du wohl nicht richtig. Die Settings werden seit uralten DOS-Zeiten während des Startvorganges eingetragen, wobei es noch nie eine Rolle gespielt hat, in welcher Reihenfolge dies erfolgt. Da kann man mit .bat, .sys und Programmen auch selbst eingreifen.
Okay. Das wusste ich nicht.. das ich auch nicht so tief in der Informatikwelt drin stecke.
Dachte das ist so ein Standartparameter der IMMER gleich ist ...
Errare humanum est ;-D

BEste Grüße
und 1000 Dank für den COde ich berichte nächste WOche von Kreuztest!

Jack