ファイル 同階層のファイル名一覧(作成)(変換)

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

    本文印刷

    お気に入りに追加

  • 検索

    Googlewwwjp-ia
     

    Googlewwwjp-ia
     
  • 情報

  • 関連

[VB&VBA][ファイル 同階層のファイル名一覧(作成)(変換)]
Sub GetFileNamesList()
'******************************
'同階層のファイル名一覧(作成)
'******************************
Dim strFolderPath As String
Dim sht As Worksheet
Dim strFileName As String
Dim lngLow As Long

Set sht = ThisWorkbook.ActiveSheet
strFolderPath = ThisWorkbook.Path & "\"
strFileName = Dir(strFolderPath & "*.*")

lngLow = 0

With sht
    .Range(.Cells(1, 1), .Cells(65536, 1)).ClearContents
    .Range(.Cells(1, 4), .Cells(65536, 4)).ClearContents
    lngLow = lngLow + 1
    .Cells(lngLow, 1).Value = "FolderPath"
    lngLow = lngLow + 1
    .Cells(lngLow, 1).Value = strFolderPath
    lngLow = lngLow + 1
    .Cells(lngLow, 1).Value = "BeforeFileName"
    .Cells(lngLow, 2).Value = "AfterFileName"
    .Cells(lngLow, 3).Value = "Extension"
    .Cells(lngLow, 4).Value = "Result"
    lngLow = lngLow + 1

    Do Until strFileName = ""

      .Cells(lngLow, 1).Value = strFileName
      .Cells(lngLow, 3).Value = ExteOnly(strFileName)

      lngLow = lngLow + 1

      strFileName = Dir()

    Loop

End With

End Sub



Sub AllFileNameChange()
'******************************
'同階層のファイル名一覧(変換)
'******************************
Dim strFolderPath As String
Dim BeforeFileName As String
Dim AfterFileName As String
Dim lngLow As Long
Dim sht As Worksheet

Set sht = ThisWorkbook.ActiveSheet

strFolderPath = sht.Cells(2, 1).Value

lngLow = 4

On Error Resume Next

With sht
    .Range(.Cells(lngLow, 4), .Cells(65536, 4)).ClearContents
    Do Until .Cells(lngLow, 1).Value = ""

        BeforeFileName = strFolderPath & .Cells(lngLow, 1).Value
        AfterFileName = Trim(strFolderPath & .Cells(lngLow, 2).Value) & "." & .Cells(lngLow, 3).Value
        Name BeforeFileName As AfterFileName
        .Cells(lngLow, 4).Value = True

        lngLow = lngLow + 1

    Loop
End With

End Sub



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