Code vraag

[martindeboer1988]

Is het mogelijk een aanpassing te maken in onderstaande code dat ik de naam van de ingelogde persoon kan weergeven in een cel in plaats van een Msgbox?

Option Explicit 
  
Sub Users_Fullname() 
'originally coded as VB script by A.Vials, converted to VBA by Sly 
Dim objInfo 
Dim strLDAP 
Dim strFullName 
  
Set objInfo = CreateObject("ADSystemInfo") 
strLDAP = objInfo.UserName 
Set objInfo = Nothing 
strFullName = GetUserName(strLDAP) 
  
MsgBox "Full name of User is " & strFullName  'step to test 
  
End Sub 

Function GetUserName(strLDAP) 
  Dim objUser 
  Dim strName 
  Dim arrLDAP 
  Dim intIdx 
  
  On Error Resume Next 
  strName = "" 
  Set objUser = GetObject("LDAP://" & strLDAP) 
  If Err.Number = 0 Then 
    strName = objUser.Get("givenName") & Chr(32) & objUser.Get("sn") 
  End If 
  If Err.Number <> 0 Then 
    arrLDAP = Split(strLDAP, ",") 
    For intIdx = 0 To UBound(arrLDAP) 
      If UCase(Left(arrLDAP(intIdx), 3)) = "CN=" Then 
        strName = Trim(Mid(arrLDAP(intIdx), 4)) 
      End If 
    Next 
  End If 
  Set objUser = Nothing 
  
  GetUserName = strName 
  
End Function

 

[OctaFish]

Doet VBA.Environ("Username") niet hetzelfde als jouw functie?

 

[martindeboer1988]

Kan ik die op deze manier invoeren ?, excel is het niet met me eens wat doe ik fout ?

Sub test()
ActiveSheet.Range ("D16")
VBA.Environ ("Username")
End Sub

 

[HSV]

Test nog maar eens.

Sub test()
ActiveSheet.Range ("D16")= Environ ("Username")
End Sub

 

[martindeboer1988]

@HSV Dank je wel, de oplossing heeft gewerkt en ik moet echt nog flink timmeren aan mijn VBA merk ik wel weer haha.

 

[martindeboer1988]

Even een kleine vraag nog, ik wil graag dat Excel de username checkt bij openen van de sheet alleen doet die dit niet.
Code heb ik als onderstaand.

Private Sub Workbook_Open()
ActiveSheet.Range("D16") = Environ("Username")
End Sub

 

[HSV]

Staat de code in Thisworkbook-module?
Code is voor het openen van je werkboek.

 

[martindeboer1988]

De code staat onder de rest van de VBA code onder de sheet "Portal"

Private Sub PDF_reparatie_headset_Click()
Dim FacName As String
    

    'De macro haalt met deze opdracht gegevens op in het document, om deze later als naam voor het PDF-bestand te gebruiken.
    FacName = ActiveSheet.Range("XFD9").Value & ".pdf"
    
    'De folder waarin het bestand moet worden opgeslagen
    Map = "T:\Facilities-NL\Leeuwarden algemeen\Beveiliging\D&B\Filing\reparatie headset\"
    If Dir(Map, vbDirectory) = "" Then
        MsgBox "De folder " & Map & " bestaat niet"
        Exit Sub
    End If
       
    'Een controle om geen bestaand PDF-bestand te overschrijven.
    If Dir(Map & FacName) <> "" Then
       MsgBox "Het bestand: " & FacName & " bestaat reeds"
    Else
        On Local Error GoTo Fout
        Sheets("PDF_reparatie_HS").Range("A1:I3").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Map & FacName, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        MsgBox "Het bestand: " & FacName & " is opgeslagen"
        Exit Sub
    End If
    
Fout:
    MsgBox "Het bestand: " & FacName & " is NIET opgeslagen"
End Sub

Private Sub PDF_uitgifte_headset_Click()
Dim FacName As String
    

    'De macro haalt met deze opdracht gegevens op in het document, om deze later als naam voor het PDF-bestand te gebruiken.
    FacName = ActiveSheet.Range("XFD10").Value & ".pdf"
    
    'De folder waarin het bestand moet worden opgeslagen
    Map = "T:\Facilities-NL\Leeuwarden algemeen\Beveiliging\D&B\Filing\Uitgifte headsets\"
    If Dir(Map, vbDirectory) = "" Then
        MsgBox "De folder " & Map & " bestaat niet"
        Exit Sub
    End If
       
    'Een controle om geen bestaand PDF-bestand te overschrijven.
    If Dir(Map & FacName) <> "" Then
       MsgBox "Het bestand: " & FacName & " bestaat reeds"
    Else
        On Local Error GoTo Fout
        Sheets("PDF_uitgifte_HS").Range("A1:I37").ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Map & FacName, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=False, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
        MsgBox "Het bestand: " & FacName & " is opgeslagen"
        Exit Sub
    End If
    
Fout:
    MsgBox "Het bestand: " & FacName & " is NIET opgeslagen"
End Sub

Private Sub Workbook_Open()
ActiveSheet.Range("D16") = Environ("Username")
End Sub

 

[HSV]

Daar hoort de code niet thuis.
Zie mijn vorig schrijven.

 

[martindeboer1988]

Akkoord, code verplaatst en werkt nu naar behoren.