3
Access User und Computername mit VBA auslesen
Hallo Leute,
ich habe ein Formular und ein Unterformular darin.
Jetzt möchte ich das im Unterformular pro erfassten eintrag der Computer sowie der Username mit erfasst wird.
Mit dem Befehlsbutton Befehl20 schreibe ich den erfassten Text in das Unterformular.
Hauptformular:
Private Sub Befehl20_Click()
'------------------------------------------------------------
' Aktual
'
'------------------------------------------------------------
On Error GoTo Befehl20_Err
' Sonn_EINGABE
DoCmd.Close acForm, "Sonn_EING"
' Sonn_EINGABE
DoCmd.OpenForm "Sonn_EING", acNormal, "", "", , acNormal
Befehl20_Exit:
Exit Sub
Befehl20_Err:
MsgBox Error$
Resume Befehl20_Exit
End Sub
Unterformular:
Sub PCDaten()
Dim Netzwerk As IWshRuntimeLibrary.WshNetwork
Set Netzwerk = CreateObject("wscript.network")
Me.Netzwerk_Computername = Netzwerk.Computername
Me.Netzwerk_UserName = Netzwerk.UserName
End Sub
Was mache ich falsch? Kann mir jemand helfen?
ich habe ein Formular und ein Unterformular darin.
Jetzt möchte ich das im Unterformular pro erfassten eintrag der Computer sowie der Username mit erfasst wird.
Mit dem Befehlsbutton Befehl20 schreibe ich den erfassten Text in das Unterformular.
Hauptformular:
Private Sub Befehl20_Click()
'------------------------------------------------------------
' Aktual
'
'------------------------------------------------------------
On Error GoTo Befehl20_Err
' Sonn_EINGABE
DoCmd.Close acForm, "Sonn_EING"
' Sonn_EINGABE
DoCmd.OpenForm "Sonn_EING", acNormal, "", "", , acNormal
Befehl20_Exit:
Exit Sub
Befehl20_Err:
MsgBox Error$
Resume Befehl20_Exit
End Sub
Unterformular:
Sub PCDaten()
Dim Netzwerk As IWshRuntimeLibrary.WshNetwork
Set Netzwerk = CreateObject("wscript.network")
Me.Netzwerk_Computername = Netzwerk.Computername
Me.Netzwerk_UserName = Netzwerk.UserName
End Sub
Was mache ich falsch? Kann mir jemand helfen?
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 75695
Url: https://administrator.de/forum/access-user-und-computername-mit-vba-auslesen-75695.html
Ausgedruckt am: 23.12.2024 um 08:12 Uhr
3 Kommentare
Neuester Kommentar
Ich habe es jetzt so weit:
Private Declare Function GetUserName _
Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) _
As Long
Private Declare Function GetComputerName _
Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, _
nSize As Long) _
As Long
Public Function CurrentUserWin() As String
Dim lpUsername As String
Dim lngTmp As Long
'Bei Fehlern weitermachen
On Error Resume Next
'String mit Leerzeichen füllen
lpUsername = Space(255)
'WIN-API-Funktion aufrufen
lngTmp = GetUserName(lpUsername, 255)
If Err.Number = 0 Then
'Wenn kein Fehler aufgetreten ist
CurrentUserWin = Trim(CutNullChar(lpUsername))
Else
CurrentUserWin = ""
End If
End Function
Function CutNullChar(ByVal v As Variant) As String
'bei NULL wird - zurückgegeben
If IsNull(v) Then
v = "-"
Else
'wenn chr(0) (vbNullChar) auftritt, alles danach abschneiden
If InStr(v, vbNullChar) > 0 Then
v = Left(v, InStr(v, vbNullChar) - 1)
End If
End If
CutNullChar = v
End Function
Private Sub Form_Load()
Me!User = CurrentUserWin
End Sub
==>Es funktioniert alles bis darauf das der Computername nicht ausgegeben wird.
Das ist mein Code:
Public Function ComputerName() As String
Dim lpPCName As String
Dim lngTmp As Long
'Bei Fehlern weitermachen
On Error Resume Next
'String mit Leerzeichen füllen
lpPCName = Space(255)
'WIN-API-Funktion aufrufen
lngTmp = GetComputerName(lpPCName , 255)
If Err.Number = 0 Then
'Wenn kein Fehler aufgetreten ist
ComputerName= Trim(CutNullChar(lpComputerName))
Else
ComputerName= ""
End If
End Function
==>Wenn ich den aber einbinde funktioniert gar nichts mehr.
Ich bekomme die Meldung:
"Sie haben als Einstellung der Ereigniseigenschaft den Ausdruck Bei laden eingegeben. Dieser Ausdruck hat einen Fehler verursacht. Ds Element ist bereits in einem Objektmodul vorhanden, von der dises Objektmodul abgeleitet ist."
Kann mir jemand weiter helfen?????????
Private Declare Function GetUserName _
Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, _
nSize As Long) _
As Long
Private Declare Function GetComputerName _
Lib "kernel32" _
Alias "GetComputerNameA" (ByVal lpBuffer As String, _
nSize As Long) _
As Long
Public Function CurrentUserWin() As String
Dim lpUsername As String
Dim lngTmp As Long
'Bei Fehlern weitermachen
On Error Resume Next
'String mit Leerzeichen füllen
lpUsername = Space(255)
'WIN-API-Funktion aufrufen
lngTmp = GetUserName(lpUsername, 255)
If Err.Number = 0 Then
'Wenn kein Fehler aufgetreten ist
CurrentUserWin = Trim(CutNullChar(lpUsername))
Else
CurrentUserWin = ""
End If
End Function
Function CutNullChar(ByVal v As Variant) As String
'bei NULL wird - zurückgegeben
If IsNull(v) Then
v = "-"
Else
'wenn chr(0) (vbNullChar) auftritt, alles danach abschneiden
If InStr(v, vbNullChar) > 0 Then
v = Left(v, InStr(v, vbNullChar) - 1)
End If
End If
CutNullChar = v
End Function
Private Sub Form_Load()
Me!User = CurrentUserWin
End Sub
==>Es funktioniert alles bis darauf das der Computername nicht ausgegeben wird.
Das ist mein Code:
Public Function ComputerName() As String
Dim lpPCName As String
Dim lngTmp As Long
'Bei Fehlern weitermachen
On Error Resume Next
'String mit Leerzeichen füllen
lpPCName = Space(255)
'WIN-API-Funktion aufrufen
lngTmp = GetComputerName(lpPCName , 255)
If Err.Number = 0 Then
'Wenn kein Fehler aufgetreten ist
ComputerName= Trim(CutNullChar(lpComputerName))
Else
ComputerName= ""
End If
End Function
==>Wenn ich den aber einbinde funktioniert gar nichts mehr.
Ich bekomme die Meldung:
"Sie haben als Einstellung der Ereigniseigenschaft den Ausdruck Bei laden eingegeben. Dieser Ausdruck hat einen Fehler verursacht. Ds Element ist bereits in einem Objektmodul vorhanden, von der dises Objektmodul abgeleitet ist."
Kann mir jemand weiter helfen?????????
Hallo,
vielleicht kann Dir Karl Donaubauer helfen: http://www.donkarl.com/
Siehe Punkte 2.23 und 2.24.
Die Links führen u.a. zu: http://www.mvps.org/access/api/api0009.htm
mfg
vielleicht kann Dir Karl Donaubauer helfen: http://www.donkarl.com/
Siehe Punkte 2.23 und 2.24.
Die Links führen u.a. zu: http://www.mvps.org/access/api/api0009.htm
mfg
Die URL´s waren sehr hilfreich.
Danke
Danke
