|
Das folgende Script wählt einen Ordner aus und
speichert die Auswahl in der Regisry ab. Jedesmal wenn
wir einen Ordner für unserer Scripts benötigen,
schreiben wir einfach
set folder = GetFolder("MyFolder",false,true)
Wurde schon einmal ein Ordner mit der Bezeichnung
MyFolder ausgewählt, wird dieser geöffnet und
zurückgegeben, wurde noch keiner ausgewählt, erscheint
eine Auswahl, welche hinterher gleich in der Registry
gespeichert wird. Beim nächsten Aufruf wird dann der
Ordner ohne Dialog geöffnet.
Der zweite Paramter erzwingt die Abfrage. In einem
Einstellungsdialog schreiben wir
set folder = GetFolder("MyFolder",true,false)
Der Dritte Parameter unterdrückt die Abfrage "Wählen
Sie einen Ordner für MyFolder" aus, wenn das Script aus
einem Dialog aufgerufen wird, weiss der Anwender,
welcher Ordner es ist, wenn keine Konfiguration
vorliegt, wird er darauf hingewiesen, was ausgesucht
werden soll.
shared
Declare Function RegQueryValue Lib "advapi32.dll" Alias
"RegQueryValueA" (ByVal hKey As Long, ByVal lpSubKey As
String, ByVal lpValue As String, lpcbValue As Long) As
Long
shared Declare Function RegSetValue Lib "advapi32.dll"
Alias "RegSetValueA" (ByVal hKey As Long, ByVal lpSubKey
As String, ByVal dwType As Long, ByVal lpData As String,
ByVal cbData As Long) As Long
shared Declare Function RegSetValueEx Lib "advapi32.dll"
Alias "RegSetValueExA" (ByVal hKey As Long, ByVal
lpValueName As String, ByVal Reserved As Long, ByVal
dwType As Long, lpData As Any, ByVal cbData As Long) As
Long ' Note that if you declare the lpData parameter as
String, you must pass it By Value.
shared Declare Function RegQueryValueEx Lib
"advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As
Long, ByVal lpValueName As String, ByVal lpReserved As
Long, lpType As Long, lpData As Any, lpcbData As Long)
As Long ' Note that if you declare the lpData parameter
as String, you must pass it By Value.
shared Declare Function RegCloseKey Lib "advapi32.dll" (ByVal
hKey As Long) As Long
shared Const ERROR_SUCCESS = 0&
shared Const HKEY_CURRENT_USER = &H80000001
shared Const REG_SZ = 1 ' Unicode nul terminated string
Const FolderRegKey = "Software\MyApp"
' Gets a folder from the registry
' If this folder is not defined in the registry, we
define it and store it
' input:
' Name Name of the folder as it is identified in the
Registry
' ask Always Ask for this folder
' global FolderRegKey: Root for the registry to search
in
' output
' The folder or nothing
shared Function GetFolder(Name As String, Ask As Boolean,
prompt As Boolean) As MAPIFolder
Dim key As Long
Dim hr As Long
Dim eid As String
Dim seid As String
Dim ns As NameSpace
Dim len1 As Long
Dim typ As Long
Dim p As Long
Dim folder As MAPIFolder
Set ns = Outlook.Application.GetNamespace("MAPI")
hr = RegOpenKey(HKY_CURRENT_USER, FolderRegKey, key)
If hr <> ERROR_SUCCESS Then hr =
RegOpenKey(HKEY_CURRENT_USER, "\" & FolderRegKey, key)
If hr <> ERROR_SUCCESS Then hr =
RegCreateKey(HKEY_CURRENT_USER, FolderRegKey, key)
If hr <> ERROR_SUCCESS Then hr =
RegCreateKey(HKEY_CURRENT_USER, "\" & FolderRegKey, key)
If hr = ERROR_SUCCESS Then
' Try to read the registry key, which contains the entry
id of the folder
If Not Ask Then
eid = Space$(2000)
len1 = Len(eid)
hr = RegQueryValueEx(key, Name, 0, typ, ByVal eid, len1)
If hr = ERROR_SUCCESS Then eid = Left(eid, len1 - 1)
Else
hr = ERROR_SUCESS + 1 ' Give any error message when user
asks us to display dialog
End If
' Try to open the folder
If hr = ERROR_SUCCESS Then
p = InStr(1, eid, ":")
If p <> 0 Then
seid = Mid(eid, p + 1)
eid = Left(eid, p - 1)
End If
Set folder = ns.GetFolderFromID(eid, seid)
End If
' Either the registry key was not stored or opening has
failed, ask the user
If folder Is Nothing Then
If prompt Then
MsgBox "Select folder for " & Name
End If
Set folder = ns.PickFolder
eid = folder.EntryID & ":" & folder.StoreID
hr = RegSetValueEx(key, Name, 0, REG_SZ, ByVal eid,
Len(eid))
If hr <> ERROR_SUCCESS Then
MsgBox "Sorry, can not write Registry value " & Name
End If
End If
RegCloseKey key
End If
Set GetFolder = folder
End Function
|
Englisch
