VBA zum herauslesen der Computer Serien-Nummer oder Ähnliches?
Hallo,
gibt es eine Möglichkeit dies zu bewerkstelligen und wie sieht der Script aus?
Hintergrund ist, dass eine Anwendung nur auf einen PC erlaubt sein soll.
Mit VBA kenne ich mich nur mit "Aufzeichnen" aus.
Hatte mal eine Anfrage mit der IP-Nummer, die ich auch realisiert habe. Erstaunlicherweise musste ich feststellen, dass es nicht nur eine IP-Nummer gibt, zumindest bei einem Rechner.
3 Antworten
'In ähnlicher Weise gibt 'kernel32' noch andere Dinge zurück
Declare Function GetComputerName& Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lbbuffer As String, nsize As Long)
Sub CptName()
Dim sTxt As String * 64
Call GetComputerName(sTxt, 64)
MsgBox sTxt
End Sub
Vielen Dank für Deine Rückmeldung!
Bräuchte noch ein Ausgabescript (siehe zuvor), für Modul1.
Schau mal hier: http://www.office-loesung.de/ftopic394424_0_0_asc.php
Da geht es um "VBA MAC Adresse auslesen" oder auch "VBA read MAC address". Es gab auch noch andere Treffer in der "DuckDuckGo" Suche
Für die Zuweisung auf eine Zelle sollte ggf auch nocht dass ergänzt werden:
Worksheets("Tabelle1").Range("A5").Value = "test"
Hallo,
zunächst 1000 Dank für Deine Bemühungen.
Die Verlinkung habe ich nicht getestet, da kein MAC.
Des Weiteren habe ich mit Deinen Vorschlag Experimentiert. Als Ergebnis wird nur eine "1" ausgegeben. Außerdem ist der "ComputerName" nicht das "gelbe vom Ei", da dieser Modellabhängig ist und mehrmals Vorkommen kann.
Mit "ProductCode" und "UserName" habe ich mir was gebastelt (wie bereits erwähnt keine VBA-Kenntnisse), das auch funktioniert. Ob der "ProductCode" sich auf den PC oder der Windows-Variante bezieht, entzieht sich meiner Kenntnis. Wäre aber allerdings eine Option, da dieses auch an meinen zweiten, veralteten PC getestet habe, aber mit unterschiedlichen Windows-Varianten. Es besteht die Möglichkeit (intern) an 2 weiteren PC`s, dies zu Testen.
Der "ProductCode" ist zumindest unterschiedlich.
"ProductVersion" ist eine Zahlenkombination, die auch interessant wäre, lässt sich aber aufgrund meiner Kenntnisse, nicht einfach abrufen (VBA-Syntaxmäßig).
Jedenfalls werde ich, wie es die Zeit erlaubt, Varianten testen.
Ich werde mich auf jeden Fall, zum gegebenen Zeitpunkt wieder melden, bzw. Dein Engagement (Beurteilungsmäßig) honorieren. Schade, dass manche, trotz gelegentlichen sehr zeitraubenden Recherchen zur Lösungsfindung, seitens dem Fragesteller dies nicht honoriert wird.
Gruß Tron
Die "MAC" Adresse hat nichts mit "Apple" zu tun. Mit dieser Adresse bezeichnet man die "eigentlich" eineindeutige HW Nummer des Computers. Da man diese inzwischen auch schon "gefaked" ist die Bedeutung verringert. Allerdings sollte es für deine Zwecke nützlich sein.
Hallo,
habe spezifisch mein Problem (mit Abbildung) deklariert.
Habe zusätzlich nach Recherchen eine zusätzliche Option gefunden, jedoch funktionieren beide Varianten nicht. Weshalb entzieht sich meiner VBA-Syntax Kenntnisse.
Hast Du eine Idee was falsch sein könnte?
Ich werde Dich im Anschluss Prämieren, für den Hinweis dem auslesen der MAC Adresse.
Sicherlich werde ich die Frage, mit den Abbildungen, in "GuteFrage" nochmals stellen.
Nochmals Danke!
Code in Quelltextform.
Variante 1:
Workbook
Private Sub Workbook_Open()
If Tabelle1.Range("A1") = "" Then
Tabelle1.Range("A1") = GetMACAddress()
Tabelle1.Range("A2") = Date
End If
Tabelle1.Range("A3") = GetMACAddress()
Tabelle1.Range("A4") = Date
End Sub
Modul1
Sub read_it()
Dim objWMIService As Object
Dim objItem As Object
Dim colItems As Object
On Error Resume Next
Set objWMIService = GetObject("winmgmts:\\" & "." & "\root\cimv2")
Set colItems = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration")
For Each objItem In colItems
MsgBox "Caption: " & objItem.Caption & Chr(10) & _
"MAC Address: " & objItem.MACAddress
Next
End Sub
Variante 2:
Workbook
Private Sub Workbook_Open()
If Range("A1") = "" Then
Range("A1") = GetMACAddress()
Range("A2") = Date
End If
Range("A3") = GetMACAddress()
Range("A4") = Date
End Sub
Modul1
Function GetMACAddress() As String
Dim StrComputer As String
StrComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & StrComputer & "\root\cimv2")
Set objWIMSet = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration")
For Each objWMI In objWIMSet
If objWMI.Properties_("IPConnectionMetric") = 1 Then
GetMACAddress = objWMI.Properties_("MACAddress").Value
Exit Function
End If
Next objWMI
End Function
Gruß Tron
Hallo,
reibe mich da auf, da keinerlei VBA-Syntax Kenntnisse, was das auslesen der MAC Adresse betrifft.
Viele Varianten, ohne Erfolg, versucht.
Wo liegt der Fehler, bei beiden Varianten ?
Variante 1, Fehlermeldung.
Variante 2, keine Ausgabe, aber auch keine Fehlermeldung.
Gruß Tron
Dein "GetMACAddress" befindet sich im "Modul1". Dein anderer Code im "Workbook" Daher kennen die sich nicht.
Schreibe "Public Function GetMac…" und ergänze deinen Aufruf mit
Modul1.GetMac...
Hi,
weis nicht wie und wo, denn wie bereits erwähnt kein VBA-Plan.
Ich werde meine Code im Textformat liefern, wäre schön wenn Du den Text verändern würdest, so wie es sein soll.
1000 Dank im Voraus!
Hallo,
nochmals das ganze, was den Schriftverkehr betrifft?!
Es ist Wichtig nur eine Nummer von einem PC zu erhalten, nicht ein Name oder Computernamen, den es mehrfach in einem Unternehmen gibt.
Ich bräuchte eine Ausgabe auf eine Zelle!
Des Weiteren kann ich weitere Sicherheitsvorkehrungen treffen.
Brauche aber eine Ausgabe auf eine Zelle, so ähnlich.
Private Sub Workbook_Open() If Range("A1") = "" Then Range("A1") = GetComputerNameA() Range("A2") = Date End If Range("A3") = GetComputerNameA() Range("A4") = Date End SubDies funktioniert nicht. Abbildung konnte ich nicht beifügen ???
Andere Idee
Gruß Tron