Excel VBA練習 VBScript_RegExp_55.RegExp

メモ

ファイル名"バインダー1_Part1.pdf"といった連番ファイルだけが入ったフォルダ内のファイル名をワークシートに書き出す使い捨てExcelマクロ。連番部分の抽出に便利。
ファイル名の文字列の分割に VBScript_RegExp_55.RegExp を使っているだけ。

Excelマクロを使わなくても以下のようにしたほうが、臨機応変に早く作業できそうな気がする。

• コマンドプロンプトで dir /b | clip としてファイル名をクリップボードにコピー
• ワークシートで LEFT, RIGHT, SUBSTITUTE, VALUE, TEXT などの関数を組み合わせて文字列を整形
• コマンドプロンプトに ren "oldname" "newname" の形で貼り付け

参考資料リンク

• Regular Expression Programming (Scripting) | Microsoft Docs
• Windows commands | Microsoft Docs

使い捨てマクロ

' Excel 2019, Windows 10

' 参照設定
' Microsoft VBScript Regular Expressions 5.5
' Windows Script Host Object Model

Option Explicit

Public Sub Main()
  ' 適当なフォルダ
  Dim pathFolder As String
  pathFolder = VBA.Interaction.Environ("USERPROFILE") & "\Desktop\tmp123"

  Dim xlsWb As Excel.Workbook
  Dim xlsWs As Excel.Worksheet

  Dim fso As IWshRuntimeLibrary.FileSystemObject
  Dim fld As IWshRuntimeLibrary.Folder
  Dim f As IWshRuntimeLibrary.File
  Dim i As Long
  Dim str As String

  Dim re As VBScript_RegExp_55.RegExp
  Dim Matches As VBScript_RegExp_55.MatchCollection

  ' 新しいワークブックを作成
  Set xlsWb = Excel.Application.Workbooks.Add( _
    Template:=Excel.XlWBATemplate.xlWBATWorksheet)
  Set xlsWs = xlsWb.Worksheets("Sheet1")

  ' フォルダを取得
  Set fso = New IWshRuntimeLibrary.FileSystemObject
  Set fld = fso.GetFolder(FolderPath:=pathFolder)

  ' 正規表現
  ' 例 "バインダー1_Part123.pdf"
  Set re = New VBScript_RegExp_55.RegExp
  re.Pattern = "(.*)(_)(Part)(\d+)(\.pdf)"
  re.IgnoreCase = True
  re.Global = True
  re.MultiLine = False

  ' セルの書式を設定
  xlsWs.Range("A:A").NumberFormatLocal = "G/標準"
  xlsWs.Range("B:G").NumberFormatLocal = "@"

  ' フォルダ内のファイル名をワークシートに出力する
  i = 1
  For Each f In fld.Files
    str = fso.GetFileName(Path:=f.Path)

    Set Matches = re.Execute(sourceString:=str)

    If Matches.Count = 0 Then
      Err.Raise Number:=VBA.Constants.vbObjectError + 65535, _
        Description:="notmatch: " & str
    End If

    xlsWs.Cells(i, 1).Value = VBA.Conversion.CInt(Expression:=Matches(0).SubMatches(3))
    xlsWs.Cells(i, 2).Value = str
    xlsWs.Cells(i, 3).Value = Matches(0).SubMatches(0)
    xlsWs.Cells(i, 4).Value = Matches(0).SubMatches(1)
    xlsWs.Cells(i, 5).Value = Matches(0).SubMatches(2)
    xlsWs.Cells(i, 6).Value = Matches(0).SubMatches(3)
    xlsWs.Cells(i, 7).Value = Matches(0).SubMatches(4)

    i = i + 1
  Next f

  xlsWs.Range("A:G").Columns.AutoFit

  xlsWs.Range("A:G").Sort _
    Key1:=xlsWs.Range("A:A"), _
    Order1:=Excel.XlSortOrder.xlAscending, _
    Header:=Excel.XlYesNoGuess.xlNo, _
    MatchCase:=False, _
    Orientation:=Excel.XlSortOrientation.xlSortColumns, _
    SortMethod:=Excel.XlSortMethod.xlPinYin, _
    DataOption1:=Excel.XlSortDataOption.xlSortTextAsNumbers

End Sub