【Functionメモ】情報取得やファイル関連をまとめる

'-----------------------------------------
'関数名　：fncGetFileNameList
'機能　　：入力されたセルに入力されたフォルダから一覧を取得する
'-----------------------------------------
Function fncGetFileNameList()
    Dim str対象フォルダパス As String
    Dim intR As Integer
    
    intR = 5
    
    '---50000行ぐらい削除で初期化
    Rows(intR & ":" & 50000).Delete
    
    '---フォルダ一覧作成対象のフォルダパス（シートから取得）
    str対象フォルダパス = Range("c2").Value
    
    '---"\"マークが無ければ、つける
    If Right(str対象フォルダパス, 1) <> "\" Then
    str対象フォルダパス = str対象フォルダパス & "\"
    End If
    
    '---一覧取得実行
    Call getFil(str対象フォルダパス, intR)
    MsgBox ("完了")

End Function

'-----------------------------------------
'関数名　：getFil
'機能　　：入力されたフォルダからファイル名を取得。フォルダがあれば自分をそのフォルダをパラメータで再度呼び出す。
'-----------------------------------------
Sub getFil(str対象フォルダパス As String, intR As Integer)
Dim objFs As Object
Dim obj対象フォルダ As Object
Dim objサブフォルダ達 As Object
Dim objサブフォルダ As Object
Dim objファイル As Object

Set objFs = CreateObject("Scripting.FileSystemObject")
    
    '---フォルダオブジェクト取得
    Set obj対象フォルダ = objFs.getfolder(str対象フォルダパス)
    
    '---まずは、サブフォルダ達オブジェクトを取得
    Set objサブフォルダ達 = obj対象フォルダ.subfolders
    
    '---サブフォルダオブジェクト毎に実行
    For Each objサブフォルダ In objサブフォルダ達
        
        '---サブフォルダパスを出力する
        Range("b" & intR).Value = objサブフォルダ.Path
        intR = intR + 1
        
        '---サブフォルダパスを対象フォルダパスとして、一覧取得実行(再帰)
        Call getFil(objサブフォルダ.Path, intR)
    Next
    
    '---ここまで来たらファイルを出力
    Set objファイル達 = obj対象フォルダ.Files
    For Each objファイル In objファイル達
        Range("b" & intR).Value = Replace(objファイル.Path, objファイル.Name, "")
        Range("c" & intR).Value = objファイル.Name
        intR = intR + 1
    Next

【Function名称】

【Function使い方】

【概要】

'-----------------------------------------
'関数名　：フルパスからファイル名取得（簡易版）
'機能　　：フルパスから一番\￥などで区切った一番右の物を返します。
'入力項目：フルパス
'※文字列で区切っているだけ
'-----------------------------------------
Function fGetfname(strFPath As String) As String
    Dim strFPathSplit
    '---/とか\で区切って
    strFPathSplit = Split(Replace(strFPath, "/", "\"), "\")
    '---配列の最後をセット
    fGetfname = strFPathSplit(UBound(strFPathSplit))
End Function

'-----------------------------------------
'関数名　：コンピュータ名取得
'機能　　：コンピュータの名称を取得する
'入力項目：なし
'-----------------------------------------
Function コンピュータ名取得() As String
    Dim NtwkObj As Object
    Set NtwkObj = CreateObject("WScript.Network")
    '---コンピュータ名を取得
    コンピュータ名取得 = NtwkObj.ComputerName
    Set NtwkObj = Nothing
End Function

'-----------------------------------------
'関数名　：ユーザ名取得
'機能　　：ユーザの名称を取得する
'入力項目：なし
'-----------------------------------------
Function ユーザ名取得() As String
    Dim NtwkObj As Object
    Set NtwkObj = CreateObject("WScript.Network")
    '---ユーザ名を取得
    ユーザ名取得 = NtwkObj.UserName
    Set NtwkObj = Nothing
End Function