xls ファイルを xlsx 形式に自動で変換・保存するマクロ

このブックがあるディレクトリの xls ファイルを xlsx 形式で保存するマクロ。

以下のコードをコピペしてマクロブックを作り、xls ファイルがたくさんあるフォルダに配置する。

• このブックがあるディレクトリの xls ファイルを xlsx 形式で保存する
  • ThisWorkbook.vba

Sub ConvertToXlsx()
  Application.DisplayAlerts  = False  ' 警告表示しない
  Application.ScreenUpdating = False  ' 画面描画しない
  
  ' 変換元フォルダ : このブックがあるフォルダ
  Dim inPath As String
  inPath = ActiveWorkbook.Path
  
  ' 変換後フォルダ : このブック配下に Converted フォルダを作る
  Dim outPath As String
  outPath = ActiveWorkbook.Path & "\Converted"
  
  If Dir(outPath, vbDirectory) = "" Then
    MkDir outPath
  End If
  
  ' 「.xls」を含むファイルを取得する。このままだと「.xlsx」や「.xlsm」も引っかかるのでループ内で除外する
  Dim files As String
  files = Dir(inPath & "\*.xls")
  
  Do While file <> ""
    ' 「.xls」かどうか判定
    If LCase(file) Like "*.xls" Then
      Workbooks.Open Filename:=inPath & "\" & file
      ActiveWorkbook.SaveAs Filename:=outPath & "\" & file & "x", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
      ActiveWorkbook.Close
    End If
    file = Dir()
  Loop
  
  Application.ScreenUpdating = True
  Application.DisplayAlerts  = True
  MsgBox "完了"
End Sub

マクロを実行すると、「Converted」フォルダを生成し、その中に xls 形式のファイルたちを xlsx 形式に保存し直して格納していく。

xlsx 形式で保存すると、従来の xls 形式と比べてファイルサイズが 1/3 〜 1/2 くらいに減少するので、一括で保存し直すために作ったマクロだった。

本当は、マクロ入りブックだったら xlsm 形式で保存するとか、もう少し処理を加えないといけないし、まず対象フォルダの決め方がダサいのだが、もう更新するつもりもないし、過去の遺産としてこのまんま公開。