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