Sub GetPcName()
'WshNetworkオブジェクトを生成
Dim WshNetworkObj As Object
Set WshNetworkObj = CreateObject("WScript.Network")
'コンピュータ名を取得
Dim comname As String
comname = WshNetworkObj.ComputerName
'例:コンピューター名をシート名(MST)の セルB4に入れる
Sheets("MST").Cells(4, 2) = comname
End Sub
ユーザー名を取得する
Sub GetUserName()
'WshNetworkオブジェクトを生成
Dim WshNetworkObj As Object
Set WshNetworkObj = CreateObject("WScript.Network")
'ユーザー名を取得
Dim username As String
username = WshNetworkObj.UserName
'例:ユーザー名をシート名(MST)の セルB4に入れる
Sheets("MST").Cells(4, 2) = username
End Sub
ファイルパス名からファイル名を取得する
Sub GetFilePassName()
'ThisWorkbook.FullName 呼び出したExcelシートのファイルパス名を取得する
Dim wk_nm1 As String, wk_nm2 As String
wk_nm1 = Trim(ThisWorkbook.FullName)
'ファイルパス名をシート名(MST)の セルB1に入れる
Sheets("MST").Cells(1, 2) = wk_nm1
'InStrRev(wk_nm1, "\")) パス名の文字列を後ろから検索し"\"が出たら、前から"\"までの文字数を返す
'InStr(wk_nm1, "\")) パス名の文字列を前から検索し"\"が出たら 前から"\"までの文字数を返す
wk_nm2 = Right(wk_nm1, Len(wk_nm1) - InStrRev(wk_nm1, "\"))
'ファイル名をシート名(MST)の セルB2に入れる
'ファイル名でつけた西暦4桁をシート名(MST)の セルB3に入れる
'ファイル名でつけた月2桁をシート名(MST)の セルC3に入れる
'ファイル名でつけた日2桁をシート名(MST)の セルD3に入れる
Sheets("MST").Cells(2, 2) = wk_nm2
Sheets("MST").Cells(3, 2) = Left(wk_nm2, 4) '''年
Sheets("MST").Cells(3, 3) = Mid(wk_nm2, 5, 2) '''月
Sheets("MST").Cells(3, 4) = Mid(wk_nm2, 7, 2) '''日
'ファイル名でつけた場名2文字をシート名(MST)の セルE3に入れる
Dim MyArray As Variant, i As Integer
MyArray = Array("中山", "東京", "福島", "新潟", "京都", "阪神", "中京", "小倉", "札幌", "函館")
Sheets("MST").Cells(3, 5) = ""
For i = 0 To UBound(MyArray)
If InStrRev(wk_nm2, MyArray(i)) > 0 Then
Sheets("MST").Cells(3, 5) = MyArray(i)
Exit For
End If
Next
End Sub