Hallo Anno,
Hallo Reinhard,
Das aus Redmont(d), WinXP, natürlich wäre es mehr als schick
wenn der Code auch auf allen BS ab Win98 läuft bis hin zu
diesem Vistakram.
Ok, dann hast du aber mehr Aufwand 
Unter Win9X und WinME kannst du das wie gesagt nur in der Autoexec.bat machen. Das erfordert aber einen Neustart Sprich, du muesstest erst das OS ermitteln und dann entsprechend reagieren. Das sollte aber kein Problem sein 
Wie man das macht, das weisst du?
Du kannst wie gesagt die Variablen Systemweit oder für den angemeldeten User setzen! Aber beim OS von Win9X oder WinMe kannst du sie nur Systemweit setzen!
Was genau ist der laufende Prozess? Die Vba-Prozedur die die
Umgebungsvariable setzt?
Die laufende Excelanwendung, das laufende Windows?
Damit meinte ich, das lfd. Programm. Also sprich Excel und alle durch Excel gestarteten Prozesse
Ja, WinXP beachtet die autoexec nicht.
Richtig
Ich habe deinen Code lauffähig gemacht, aber die Variable wird
nicht gesetzt, die Function liefert „Falsch“, also ist
lResultat0:
Ich habe mal was getippselt. Aber ist halt unter VB.
Option Explicit
Private Declare Function SetEnvironmentVariable \_
Lib "kernel32" Alias "SetEnvironmentVariableA" ( \_
ByVal EnvironmentVariableName As String, \_
ByVal EnvironmentVariableValue As String \_
) As Long
Private Const FORMAT\_MESSAGE\_FROM\_SYSTEM As Long = &H1000&
Private Const FORMAT\_MESSAGE\_IGNORE\_INSERTS As Long = &H200&
Private Const FORMAT\_MESSAGE\_MAX\_WIDTH\_MASK As Long = &HFF&
Private Const LANG\_USER\_DEFAULT As Long = &H400&
Private Declare Function FormatMessage \_
Lib "kernel32" Alias "FormatMessageA" ( \_
ByVal dwFlags As Long, \_
ByRef lpSource As Any, \_
ByVal dwMessageId As Long, \_
ByVal dwLanguageId As Long, \_
ByVal lpBuffer As String, \_
ByVal nSize As Long, \_
ByRef Arguments As Long \_
) As Long
Public Function APIErrorDescription(ByVal ErrLastDllError As Long) As String
Dim sBuffer As String
Dim lBufferLen As Long
sBuffer = Space$(1024)
lBufferLen = FormatMessage(FORMAT\_MESSAGE\_FROM\_SYSTEM Or FORMAT\_MESSAGE\_MAX\_WIDTH\_MASK Or FORMAT\_MESSAGE\_IGNORE\_INSERTS, ByVal 0&, ErrLastDllError, LANG\_USER\_DEFAULT, sBuffer, Len(sBuffer), 0)
If lBufferLen \> 0 Then
APIErrorDescription = Left$(sBuffer, lBufferLen)
Else
APIErrorDescription = "Unbekannter Fehler: &H" & Hex$(ErrLastDllError)
End If
End Function
Private Function SetEnviron(sName As String, Wert As String, Optional ShowError As Boolean = True) As Boolean
Dim x As Long
x = SetEnvironmentVariable(sName, Wert)
If x 0 Then
'Rückgabewert=1 -\> erfolgreich
SetEnviron = True
Else
'Rückgabewert=0 -\> Fehlgeschlagen
If ShowError Then MsgBox APIErrorDescription(Err.LastDllError)
SetEnviron = False
End If
End Function
Private Sub GetEnviron()
Dim i As Long
Dim strEnvironVars As String
i = 1
Do While LenB(Environ$(i)) \> 0
strEnvironVars = strEnvironVars & Environ$(i) & vbNewLine
i = i + 1
Loop
If LenB(strEnvironVars) \> 0 Then
strEnvironVars = Left$(strEnvironVars, Len(strEnvironVars) - 2)
End If
MsgBox "Die folgenden Umgebungsvariablen sind definiert:" & vbNewLine & vbNewLine & \_
strEnvironVars, \_
vbInformation, \_
"Definierte Umgebungsvariable"
End Sub
Private Sub Form\_Load()
SetEnviron "Peter", "Alex"
GetEnviron
End Sub
Er zeigt mir an das alles Fehlerfrei ausgefuehrt wird
Ich habe da Lücken, ist WinXP „ab ein NT basierenden OS“ ?
Vista ?
Richtig, ab Win2000 sind die OS NT Basierend
HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\SessionManager\Environment
oder
HKEY_CURRENT_USER\Environment
Sehe ich das richtig, ich kann die Variable für die
„Local_Machine“ eintragen oder/und für den jeweiligen „User“!?
Genau. Aber wenn du sie eingetragen hast, so sind sie dem System noch nicht bekannt! Du musst Windows davon erst informieren!
Gut, muß ich mal nach Registrierungsänderungscode googeln.
Kannst du nochmal schauen warum die Variable mit deinem Code
nicht gesetzt wird? Danke.
ICh habe das gepostete Demo von mir bei mir mal probiert und da läuft es anstandslos durch!
Aber sei es drum. Ich poste Dir nochmal eine Function, die die gewuenschte Arbeit macht Ist unter VB getestet. Musst nur mal schauen wie du es umstricken musst damit es unter VBA läuft.
Hierbei werden die Variablen in der Registry gesetzt 
Option Explicit
Private Const WM\_WININICHANGE As Long = &H1A&
Private Const WM\_SETTINGCHANGE As Long = WM\_WININICHANGE
Private Const SMTO\_ABORTIFHUNG As Long = &H2&
Private Const HWND\_BROADCAST As Long = &HFFFF&
Private Const KEY\_CREATE\_SUB\_KEY As Long = &H4&
Private Const KEY\_SET\_VALUE As Long = &H2&
Private Const REG\_SZ As Long = &H1&
Private Const REG\_OPTION\_NON\_VOLATILE As Long = &H0&
Private Const ERROR\_SUCCESS As Long = &H0&
Private Const VER\_PLATFORM\_WIN32\_NT As Long = &H2&
Private Enum REGISTRYKEYS
HKEY\_CLASSES\_ROOT = &H80000000
HKEY\_CURRENT\_USER = &H80000001
HKEY\_LOCAL\_MACHINE = &H80000002
HKEY\_USERS = &H80000003
HKEY\_PERFORMANCE\_DATA = &H80000004
HKEY\_CURRENT\_CONFIG = &H80000005
HKEY\_DYN\_DATA = &H80000006
End Enum
Private Declare Function SetEnvironmentVariable \_
Lib "kernel32" Alias "SetEnvironmentVariableA" ( \_
ByVal EnvironmentVariableName As String, \_
ByVal EnvironmentVariableValue As String \_
) 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 Declare Function GetVersionEx \_
Lib "kernel32" Alias "GetVersionExA" ( \_
ByRef VersionInformation As OSVERSIONINFO \_
) As Long
Private Declare Function RegCreateKeyEx \_
Lib "advapi32.dll" Alias "RegCreateKeyExA" ( \_
ByVal hKey As Long, \_
ByVal SubKey As String, \_
ByVal Reserved As Long, \_
ByVal Class As String, \_
ByVal Options As Long, \_
ByVal DesiredAccess As Long, \_
ByVal SecurityAttributes As Long, \_
ByRef hKeyResult As Long, \_
ByRef Disposition As Long \_
) As Long
Private Declare Function RegSetValueEx \_
Lib "advapi32.dll" Alias "RegSetValueExA" ( \_
ByVal hKey As Long, \_
ByVal ValueName As String, \_
ByVal Reserved As Long, \_
ByVal TypeOfValue As Long, \_
ByRef Value As Any, \_
ByVal SizeOfValue As Long \_
) As Long
Private Declare Function RegCloseKey \_
Lib "advapi32.dll" ( \_
ByVal hKey As Long \_
) As Long
Private Declare Function SendMessageTimeout \_
Lib "user32" Alias "SendMessageTimeoutA" ( \_
ByVal hWnd As Long, \_
ByVal Message As Long, \_
ByVal wParam As Long, \_
ByRef lParam As Any, \_
ByVal Flags As Long, \_
ByVal Timeout As Long, \_
ByRef Result As Long \_
) As Long
Public Function SetEnvironVar(ByVal VariableName As String, ByVal VariableValue As String, Optional ByVal Systemwide As Boolean = False) As Boolean
' VariableName: Name der neuen Umgebungsvariablen.
' VariableValue: Wert der neuen Umgebungsvariablen.
' Systemwide: Legt fest, ob eine Benutzer-Umgebungsvariable oder
' (nur WinNT) eine System-Umgebungsvariable erzeugt werden soll.
' TRUE: Es wird eine System-Umgebungsvariable erzeugt
' (hinreichende Rechte vorausgesetzt).
' FALSE: Es wird eine Benutzer-Umgebungsvariable erzeugt.
' Dieser Parameter hat unter Windows 9x/Me keine Wirkung.
' Rückgabewert: TRUE bei Erfolg, FALSE bei Misserfolg.
' -----------------------------------------------------------------
Dim OSVI As OSVERSIONINFO
Dim ff As Integer
SetEnvironmentVariable VariableName, VariableValue
OSVI.dwOSVersionInfoSize = Len(OSVI)
GetVersionEx OSVI
If OSVI.dwPlatformId VER\_PLATFORM\_WIN32\_NT Then
On Error Resume Next
ff = FreeFile()
Open "c:\autoexec.bat" For Append As #ff
Print #ff, "SET " & VariableName & "=" & VariableValue
Close #ff
SetEnvironVar = (Err.Number = 0)
Exit Function
End If
If Systemwide Then
If RegWriteString(HKEY\_LOCAL\_MACHINE, "SYSTEM\CurrentControlSet\Control\Session Manager\Environment", VariableName, VariableValue) = False Then
Exit Function
End If
Else
If RegWriteString(HKEY\_CURRENT\_USER, "Environment", VariableName, VariableValue) = False Then
Exit Function
End If
End If
Change "Environment"
SetEnvironVar = True
End Function
Private Function RegWriteString(ByVal ToplevelKey As REGISTRYKEYS, ByVal SubKey As String, ByVal ValueName As String, ByVal Value As String) As Boolean
Dim RetVal As Long
Dim hKey As Long
Dim lngDisposition As Long
If Left$(SubKey, 1) = "\" And Len(SubKey) \> 1 Then SubKey = Mid$(SubKey, 2)
RetVal = RegCreateKeyEx(ToplevelKey, SubKey, 0, vbNullString, REG\_OPTION\_NON\_VOLATILE, KEY\_CREATE\_SUB\_KEY Or KEY\_SET\_VALUE, 0, hKey, lngDisposition)
If RetVal = ERROR\_SUCCESS Then
RetVal = RegSetValueEx(hKey, ValueName, 0, REG\_SZ, ByVal Value, Len(Value))
RegWriteString = (RetVal = ERROR\_SUCCESS)
End If
RegCloseKey hKey
End Function
Private Sub Change(Optional ByVal Area As String, Optional ByVal Timeout As Long = 5000&:wink:
Dim lResult As Long
SendMessageTimeout HWND\_BROADCAST, WM\_SETTINGCHANGE, 0, ByVal Area, SMTO\_ABORTIFHUNG, Timeout, lResult
End Sub
Private Sub GetEnvironVar()
Dim i As Long
Dim strEnvironVars As String
i = 1
Do While LenB(Environ$(i)) \> 0
strEnvironVars = strEnvironVars & Environ$(i) & vbNewLine
i = i + 1
Loop
If LenB(strEnvironVars) \> 0 Then
strEnvironVars = Left$(strEnvironVars, Len(strEnvironVars) - 2)
End If
MsgBox "Die folgenden Umgebungsvariablen sind definiert:" & vbNewLine & vbNewLine & strEnvironVars, vbInformation, "Definierte Umgebungsvariable"
End Sub
Private Sub Form\_Load()
SetEnvironVar "TestEintrag", "Test"
End Sub
Was mir aber hierbei aufgefallen ist, ist folgendes.
Der wert wird gesetzt. Aber wenn ich mir alle Umgebungsvariablen anzeigen lasse, mittels dem geposteten Code ( GetEnvironVar) bekomme ich ihn nicht angezeigt. Rufe ich jedoch die DOS Console auf und Gebe dort Set ein, so sehe ich ihn!
Laut microsoft, ist das aber normal. Ich zitiere mal ein Stueckchen.
Zitat:
Allein durch einen Eintrag in der Registry würden diese Umgebungsvariablen erst nach einem Windows-Neustart ausgelesen und gesetzt werden.
Um zu erreichen, dass nach dieser Änderung gestartete Anwendungen dennoch die neuen Variablen berücksichtigen, wird die Nachricht WM_SETTINGCHANGE mithilfe der Funktion SendMessageTimeout an alle Hauptfenster auf dem Desktop gesendet.
Als symbolisches Fensterhandle aller Empfänger wird dafür HWND_BROADCAST eingesetzt.
Auf bereits gestartete Anwendungen hat die Änderung jedoch keine Einwirkung.
Gruß
Reinhard
MfG Alex
