[ExcelVBA] ようこそ画面の名前

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 13日目

掲示板のような書き込み式のプログラムを作った際に
名前を自動で指定したいなんてことありますよねぇ。

会社なんかだと、ログインユーザー名がアルファベットで[苗字の頭文字]_[名前]
そして、ようこそ◯◯　って画面で漢字の名前が指定されていたりしますよね。
VBAからだと手っ取り早く取得できるのが、ログインユーザー名の方で下記で取得できます。

CreateObject("WScript.Network").UserName

ログとして取得するならまだしも、利用者同士が目にするとこで利用するなら
ようこそ◯◯画面で表示されるFullNameの方を取得したいものです。
FullNameのデータを取得する方法はいくつかあるのですが
セキュリティの関係で取得できないものがあったりするので
自分の環境で取得できたコードをのっけておきます。
他の方法、ネットで検索したらボロボロでてくるのでそちらにおまかせしておきます。

ここで紹介するのは、WMIを使った方法です。

view plainprint?

1. Option Explicit  
2.   
3. Sub main()  
4.     Dim FullName As String  
5.     Dim Locator  As Object  
6.     Dim Service  As Object  
7.     Dim QfeSet   As Object  
8.     Dim Qfe      As Variant  
9.     Dim UserName As String  
10.       
11.     '** Objectの生成 **  
12.     Set Locator = CreateObject("WbemScripting.SWbemLocator")  
13.     Set Service = Locator.ConnectServer  
14.     Set QfeSet = Service.ExecQuery("Select * From Win32_NetworkLoginProfile")  
15.   
16.     UserName = CreateObject("WScript.Network").UserName  
17.   
18.     For Each Qfe In QfeSet  
19.         '名前にログイン名が使われているオブジェクトのFullNameを取得をしたい  
20.         If 0 < InStr(Qfe.Name, UserName) Then  
21.               
22.             FullName = Qfe.FullName  
23.           
24.         End If  
25.       
26.     Next  
27.   
28.     MsgBox FullName  
29.   
30.     Set QfeSet = Nothing  
31.     Set Service = Nothing  
32.     Set Locator = Nothing  
33. End Sub  

Option Explicit

Sub main()
    Dim FullName As String
    Dim Locator  As Object
    Dim Service  As Object
    Dim QfeSet   As Object
    Dim Qfe      As Variant
    Dim UserName As String
    
    '** Objectの生成 **
    Set Locator = CreateObject("WbemScripting.SWbemLocator")
    Set Service = Locator.ConnectServer
    Set QfeSet = Service.ExecQuery("Select * From Win32_NetworkLoginProfile")

    UserName = CreateObject("WScript.Network").UserName

    For Each Qfe In QfeSet
        '名前にログイン名が使われているオブジェクトのFullNameを取得をしたい
        If 0 < InStr(Qfe.Name, UserName) Then
            
            FullName = Qfe.FullName
        
        End If
    
    Next

    MsgBox FullName

    Set QfeSet = Nothing
    Set Service = Nothing
    Set Locator = Nothing
End Sub

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar