Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1536to1540
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Environ Name tauschen (Syntax)

Environ Name tauschen (Syntax)
26.01.2017 13:50:28
Josef_T
Guten Tag zusammen,
Habe bislang ein bestimmtes Programm so gesichert s. unten. Meine Frage: kann man den "Computername" gegen "Festplatten Nr.?" austauschen? Wenn Ja, wie schreibt man
das denn?
'If VBA.Environ("Computername") "BM-6UCORNO3HTLE" Then ThisWorkbook.Close False
Danke
Gruß
Josef

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Environ Name tauschen (Syntax)
26.01.2017 14:17:06
MatthiasG
Hallo Josef,
folgenden Code in separates Modul in die Mappe integrieren:

' ####HD-SERIENNUMMER ####
Option Explicit
Private Type IntLongType
i1 As Integer
i2 As Integer
End Type
Private Type LongType
l As Long
End Type
Private Declare Function GetVolumeInformation Lib "kernel32" Alias _
"GetVolumeInformationA" (ByVal RootPath As String, _
ByVal VolumeNameBuffer As String, _
ByVal VolumeNameSize As Integer, VolumeSerialNumber As Long, _
MaximumComponentLength As Long, FileSystemFlags As Long, _
ByVal FileSystemNameBuffer As String, _
ByVal FileSystemNameSize As Long) As Long
' Seriennumer des angegebenen Laufwerks ermitteln
Public Function GetVolSerialNo(ByVal sDrive As String) As Long
Dim sComputer As String
Dim oWMI As Object
Dim oDrives As Object
Dim oDrive As Object
' Fehlerbehandlung aktivieren
On Error GoTo ErrHandler
sDrive = UCase$(sDrive)
If Len(sDrive) > 2 Then sDrive = Left$(sDrive, 2)
If Right$(sDrive, 1)  ":" Then sDrive = sDrive & ":"
' aktuelles System
sComputer = "."
' WMI-Objekt erstellen
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
& sComputer & "\root\cimv2")
' WMI-Abfrage erstellen
Set oDrives = oWMI.ExecQuery("Select * from Win32_LogicalDisk WHERE DeviceID='" & sDrive & "'" _
)
For Each oDrive In oDrives
' SerialNo von HEX-Darstellung nach Long-Wert umwandeln
GetVolSerialNo = CLng("&H" & oDrive.VolumeSerialNumber)
Exit For
Next
On Error GoTo 0
Exit Function
ErrHandler:
' Fehler!
' Entweder kein WMI installiert oder ungültige Laufwerksangabe
On Error GoTo 0
End Function
Public Function VolumeSerialHex(Volume As Variant, _
Optional Separator As String = "-") As String
Dim nL As LongType
Dim nI As IntLongType
nL.l = GetVolSerialNo(Volume)
LSet nI = nL
VolumeSerialHex = Right$("0000" & Hex$(nI.i2), 4) & Separator _
& Right$("0000" & Hex$(nI.i1), 4)
End Function
Dann dein Code so:

If VolumeSerialHex("C")  "3A34-AAE8" Then ThisWorkbook.Close False

Gruß Matthias
Anzeige
AW: Environ Name tauschen (Syntax)
26.01.2017 14:37:06
Josef_T
Hallo MatthiasG.
Danke sehr für Deine sehr umfangreiche Hilfe!
Es funktioniert.
Gruß
Josef
AW: Environ Name tauschen (Syntax)
26.01.2017 14:50:32
MatthiasG
Ich hab das selbst nicht geschrieben, sondern mal bei vbfun.de oder so kopiert.
Ich leite den Dank an den unbekannten Verfasser weiter ;-)
Gruß Matthias

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige