SerialNumber

Public Sub SerNummer() Dim fs Dim Laufwerk Set fs = CreateObject("Scripting.filesystemobject") On Error Resume Next For Each Laufwerk In fs.drives If Laufwerk = "C:" Then k = Laufwerk.SerialNumber Range("B40").Value = k End If Next End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: SerialNumber

15.05.2009 15:02:41

Rudi

AW: SerialNumber

15.05.2009 15:02:57

Hajo_Zi

SerialNumber zuvor löschen !

15.05.2009 15:56:02

NoNet

AW: Problem gelöst

15.05.2009 17:52:25

Hajo_Zi

Option Explicit ' Code von Sisto Public Function LwSerieNr(Drive) As Variant ' Funktion zur Ermittlung der Serien Nummer Dim FS As Object Set FS = CreateObject("Scripting.FileSystemObject") On Error Resume Next LwSerieNr = FS.GetDrive(Drive).SerialNumber If Err > 0 Then LwSerieNr = Drive & " nicht verfügbar" End Function Sub Start() MsgBox LwSerieNr("C:\") End Sub

Hallo Jerry,
mit On Error Resume Next übergehst Du die Fehler.
Wenn also bei der Zuweisung der Seriennr an die Variable k ein Fehler auftritt, enthält diese noch die Nr. des vorherigen Laufwerks (bzw. ihren alten Wert) !
Daher kann es sein, dass für ein Laufwerk, das keine SN besitzt noch die des vorherigen Laufwerks angezeigt wird. Lösche die Variable k vor der Zuweisung und die Anzeige stimmt wieder.
Weiterhin kann es natürlch sein, dass ein physikalisches Laufwerk in mehrere Partitionen unterteilt ist bzw. mehrere Mappings auf das gleiche Netzlaufwerk angelegt sind. In beiden Fällen werden für die entsprechenden PArtitionen/Mappings die identsichen SN ermittelt (LOGO : ist ja die gleiche physikalisch Platte ;-).
Teste doch mal dieses Makro auf Deinen PCs :

VBA-Code:

Public Sub SerNummer()
Dim fs As Object
Dim objLaufwerk As Object, strSN As String, strAlleSN As String
Set fs = CreateObject("Scripting.filesystemobject")
On Error Resume Next
For Each objLaufwerk In fs.drives
'Seriennr. zuvor löschen, da ansonsten SN des vorherigen Laufwerks drinsteht

        strSN = ""

        strSN = objLaufwerk.SerialNumber

        strAlleSN = strAlleSN & objLaufwerk & " " & strSN & vbLf
Next

    MsgBox strAlleSN
End Sub

Gruß, NoNet

					 AW: Problem gelöst
				
					Hajo_Zi
				
Hallo Jerry,

hat mir per Mail mitgeteilt Problem gelöst, der Admin hat die Festplatten geklont.

Gruß Hajo

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread