ファイル 同階層のファイル名取得-ファイル名(拡張子無し)と拡張子だけを取得_FSO_vs_Dir

VB&VBA
FROG ふろっぐ
 
  • オプション

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][ファイル 同階層のファイル名取得-ファイル名(拡張子無し)と拡張子だけを取得_FSO_vs_Dir]
Option Explicit


Sub 同階層のファイル名取得()
'***********************************
'同階層のファイル名取得 FSO vs Dir
'***********************************

Dim strFilePath As String
Dim objFSO As Object
Dim strOpenPath As String
Dim objFolder As Object
Dim objFile As Object
Dim strFileNameFSO As String 'A
Dim strFileNameDIR As String 'B
Dim lngCnt As Long

lngCnt = 0
strOpenPath = ThisWorkbook.Path

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strOpenPath)

    'フォルダ直下(同階層)
    For Each objFile In objFolder.Files
        strFilePath = objFile.Path '絶対パスを取得
        strFileNameFSO = objFSO.GetFileName(strFilePath) '-A
        strFileNameDIR = Dir(strFilePath, vbNormal)      '-B
        lngCnt = lngCnt + 1
        Debug.Print lngCnt & " -FSO- " & strFileNameFSO '-A
        Debug.Print lngCnt & " -FSO- " & NameOnly(strFileNameFSO) '-A
        Debug.Print lngCnt & " -FSO- " & ExteOnly(strFileNameFSO) '-A
        Debug.Print lngCnt & " -DIR- " & strFileNameDIR '-B
        Debug.Print lngCnt & " -DIR- " & NameOnly(strFileNameDIR) '-B
        Debug.Print lngCnt & " -DIR- " & ExteOnly(strFileNameDIR) '-B
    Next

Set objFSO = Nothing

MsgBox "処理終了" & vbNewLine & lngCnt & " 個のファイルが見つかりました。", 0, "処理終了"

'B-Dir(strFilePath, vbNormal)引数
'引数は省略[Dir(strFilePath)]可能ですが[vbNormal]になります。
'引数定数       値 内容
'vbNormal        0 標準ファイル
'vbReadOnly      1 読み取り専用ファイル
'vbHidden        2 隠しファイル
'vbSystem        4 システム ファイル。Macintosh不可
'vbVolume        8 ボリューム ラベル。属性無効。Macintosh不可。
'vbDirectory    16 フォルダ
'vbAlias        64 エイリアス ファイル。Macintoshのみ

'【Thumbs.dbなど】
'このサンプルではファイルのカウントをしていますがカウントした
'数値は仮に10個でも9個のファイル名しか取得しない場合があります。
'AのFSOの場合はこれが取得可能ですがBのDirの場合はどの定数を使用して
'も取得出来ません。その場合は名前が取得出来ない為、空白になります。


End Sub


Function NameOnly(strFileName As StringAs String
'*********************************
'ファイル名だけ取得(拡張子除去)
'*********************************
'引数はファイル名(パス無し)

Dim P As Long
Dim strGetName As String

P = InStr(1, strFileName, ".", vbTextCompare)

If P <> 0 Then
    strGetName = Left(strFileName, P - 1)
    NameOnly = strGetName
Else
    NameOnly = "-NameNothing-"
End If

'InStr引数(省略した場合[vbUseCompareOption])
'定数 値 説明
'vbUseCompareOption -1 Option Compare ステートメントの設定を使用して比較を行います。
'vbBinaryCompare     0 バイナリ モードの比較を行います。
'vbTextCompare       1 テキスト モードの比較を行います。
'vbDatabaseCompare   2 Microsoft Access のみ

End Function


Function ExteOnly(strFileName As StringAs String
'*********************************
'拡張子だけ取得(ファイル名除去)
'*********************************
'引数はファイル名(パス無し)

Dim P As Long
Dim strGetExtension As String

P = InStr(1, strFileName, ".", vbTextCompare)

If P <> 0 Then
    strGetExtension = Mid(strFileName, P + 1)
    ExteOnly = strGetExtension
Else
    ExteOnly = "-ExtensionNothing-"
End If

'InStr引数(省略した場合[vbUseCompareOption])
'定数 値 説明
'vbUseCompareOption -1 Option Compare ステートメントの設定を使用して比較を行います。
'vbBinaryCompare     0 バイナリ モードの比較を行います。
'vbTextCompare       1 テキスト モードの比較を行います。
'vbDatabaseCompare   2 Microsoft Access のみ

End Function






Production Japan Import Application. Since 1998