xls形式ファイルをxlsxとxlsm形式に一括変換する

xlsをxlsxとxlsmに変換するマクロ

Excel2003まではxlsの拡張子でしたが、Excel2007からはマクロを含まないブックはxlsxになり、マクロを含む場合はxlsmになりました。

このxls形式ファイルをxlsxとxlsmに変換するマクロを紹介します。

ここでは対象の１ファイルを変換する単純な方法と、指定フォルダ配下のサブフォルダも含む全てのxlsファイルを変換する方法の２つを紹介します。

1. 対象のxlsファイルをxlsxまたはxlsmに変換するマクロ

以下のマクロは引数で指定したxlsファイルをxlsxまたはxlsmファイルに変換します。

変換処理の重要な部分は19行目から25行目の判定です。HasVBProject メソッドでVBAのコードを含んでいるかどうかが分かります。なお、HasVBProject メソッドはExcel2003までのVBAには存在しません。

ここでxlsxとなるかxlsmとなるかが分かれます。

36行目で変換後のファイルを保存します。引数には事前に判定済みの変換後のファイル名（Filename）とファイル形式（FileFormat）を指定します。

VBAのコードをもっていない場合にフォーマットとしてXlFileFormat列挙型のxlOpenXMLWorkbook（Excelブック）を指定していますが、これはxlWorkbookDefault（ブックの既定値）と定数値は51で同じです。

変換前のxlsファイルが不要な場合は40行目のコメントをはずしてください。

Sub xlsTo2007(a_sPath)
    Dim wb      As Workbook     '// Workbookオブジェクト
    Dim ext     As String       '// 拡張子文字列
    Dim sPath   As String       '// ファイルパス
    Dim iFormat As XlFileFormat '// 保存形式
    
    '// 拡張子がxlsでない場合は変換しない
    If (LCase(Right(a_sPath, 4)) <> ".xls") Then
        Exit Sub
    End If
    
    '// 引数ブックをWorkbookオブジェクトとして取得
    Set wb = Workbooks.Open(a_sPath)
    
    '// 拡張子を除いたファイルパスを取得
    sPath = wb.Path & "\" & Left(wb.Name, Len(wb.Name) - 4) '// "\"はパス区切り文字
    
    '// VBAコードを持っている場合
    If (wb.HasVBProject = True) Then
        ext = ".xlsm"
        iFormat = xlOpenXMLWorkbookMacroEnabled
    Else
        ext = ".xlsx"
        iFormat = xlOpenXMLWorkbook
    End If
    
    '// 変換後のファイルと同じファイル名が存在する場合
    If (Dir(sPath & ext) <> "") Then
        '// ファイル名にタイムスタンプを付与する
        sPath = sPath & "_" & Format(Now(), "yyyymmdd_hhmmss") & ext
    Else
        sPath = sPath & ext
    End If
    
    '// 保存
    Call wb.SaveAs(Filename:=sPath, FileFormat:=iFormat)
    Call wb.Close
    
    '// 元ファイルの削除
'    Call Kill(a_sPath)
End Sub

Sub xlsTo2007(a_sPath)

Dim wb As Workbook '// Workbookオブジェクト

Dim ext As String '// 拡張子文字列

Dim sPath As String '// ファイルパス

Dim iFormat As XlFileFormat '// 保存形式

'// 拡張子がxlsでない場合は変換しない

If (LCase(Right(a_sPath, 4)) <> ".xls") Then

Exit Sub

End If

'// 引数ブックをWorkbookオブジェクトとして取得

Set wb = Workbooks.Open(a_sPath)

'// 拡張子を除いたファイルパスを取得

sPath = wb.Path & "\" & Left(wb.Name, Len(wb.Name) - 4) '// "\"はパス区切り文字

'// VBAコードを持っている場合

If (wb.HasVBProject = True) Then

ext = ".xlsm"

iFormat = xlOpenXMLWorkbookMacroEnabled

Else

ext = ".xlsx"

iFormat = xlOpenXMLWorkbook

End If

'// 変換後のファイルと同じファイル名が存在する場合

If (Dir(sPath & ext) <> "") Then

'// ファイル名にタイムスタンプを付与する

sPath = sPath & "_" & Format(Now(), "yyyymmdd_hhmmss") & ext

Else

sPath = sPath & ext

End If

'// 保存

Call wb.SaveAs(Filename:=sPath, FileFormat:=iFormat)

Call wb.Close

'// 元ファイルの削除

' Call Kill(a_sPath)

End Sub

上の関数の使い方の例です。xlsファイルのフルパスを渡すだけですね。

Sub xlsTo2007Test()
    Dim s
    
    s = "C:\web\test\xlsx.xls"
    Call xlsTo2007(s)
    
    s = "C:\web\test\xlsm.xls"
    Call xlsTo2007(s)
End Sub

Sub xlsTo2007Test()

Dim s

s = "C:\web\test\xlsx.xls"

Call xlsTo2007(s)

s = "C:\web\test\xlsm.xls"

Call xlsTo2007(s)

End Sub

2. 指定フォルダ配下のサブフォルダの全xlsファイルをxlsxまたはxlsmに変換するマクロ

指定フォルダ配下の全xlsファイルに対して実施します。再帰による処理を行い全てのサブフォルダに対して処理を行うためにFileSystemObjectクラスを利用しています。

変換処理は上のxlsTo2007関数を使います。21行目の部分です。

以下のコードではFileSystemObjectを参照設定した状態になっていることが前提になります。

そのため、VBA画面のツールメニュー→参照設定を選び、Microsoft Scripting Runtimeにチェックする必要があります。

Sub xlsTo2007Dir(a_sFolder)
    Dim oFso                    As New FileSystemObject
    Dim oFolder                 As Folder
    Dim oSubFolder              As Folder
    Dim oFile                   As File
    
    '// フォルダがない場合
    If (oFso.FolderExists(a_sFolder) = False) Then
        Exit Sub
    End If
    
    Set oFolder = oFso.GetFolder(a_sFolder)
    
    '// サブフォルダを再帰（サブフォルダを探す必要がない場合はこのFor文を削除してください）
    For Each oSubFolder In oFolder.SubFolders
        Call xlsTo2007Dir(oSubFolder.Path)
    Next
    
    '// カレントフォルダ内のファイルを取得
    For Each oFile In oFolder.Files
        Call xlsTo2007(oFile.Path)
    Next
End Sub

Sub xlsTo2007Dir(a_sFolder)

Dim oFso As New FileSystemObject

Dim oFolder As Folder

Dim oSubFolder As Folder

Dim oFile As File

'// フォルダがない場合

If (oFso.FolderExists(a_sFolder) = False) Then

Exit Sub

End If

Set oFolder = oFso.GetFolder(a_sFolder)

'// サブフォルダを再帰（サブフォルダを探す必要がない場合はこのFor文を削除してください）

For Each oSubFolder In oFolder.SubFolders

Call xlsTo2007Dir(oSubFolder.Path)

'// カレントフォルダ内のファイルを取得

For Each oFile In oFolder.Files

Call xlsTo2007(oFile.Path)

End Sub

上の関数の使い方の例です。変換したいxlsファイルのルートフォルダを渡します。

Sub xlsTo2007DirTest()
    Dim s As String
    
    s = "C:\web\test\a\"
    Call xlsTo2007Dir(s)
End Sub

Sub xlsTo2007DirTest()

Dim s As String

s = "C:\web\test\a\"

Call xlsTo2007Dir(s)

End Sub

xlsをxlsxとxlsmに変換するマクロ

1. 対象のxlsファイルをxlsxまたはxlsmに変換するマクロ

2. 指定フォルダ配下のサブフォルダの全xlsファイルをxlsxまたはxlsmに変換するマクロ

関連記事