自作VBAツール：複数のxlsx/xlsを相互変換する

エクセルで「このフォルダの中のxlsxファイルをまとめて自動的にxlsに変換できないかなぁ（またはその逆）」ということはないですか？

今回、VBA初めて3日間の初心者の私がVBAでマクロを作ってみたので公開します。

動作対象

• Windows版のExcel2007以降が対象
  • 作成は、Windows 10上のExcel 365で行いました
• Windows固有の内部コマンドを使っているので、Mac版のExcelでは動きません

開発の経緯

エクセルではバージョン2003までのファイル形式が拡張子xls、2007以降はxlsxとなって互換性がありません。

よって、ファイル形式を変える場合は、いったんファイルを開いて形式を変えて保存という作業が必要になります。

また、ネットでググると有料の変換ツールがいくつも見つかりますが、無料は見つかりませんでした。

そこで、xlsxとxlsの相互変換だけのシンプルなツールをVBAマクロで作ってみました。

 

自作VBAマクロのダウンロード

以下のリンクをクリックして、ファイルをダウンロードしてください。

• マクロ_xlsxとxlsの相互変換_20200203

 

ダウンロードして最初にファイルを開くと、以下の画面のように「保護ビュー」が出ますが、「編集を有効にする」をクリックしてください。

理由は、これをクリックしないと、画面に配置しているボタンが使えないためです。

 

いったんファイルが閉じて再度開くと、以下の画面のように「セキュリティの警告」が出るので、「コンテンツの有効化」をクリックします。

 

これで、VBAマクロが使えるようになるはずです。

VBAの内容

データ形式を変換するモジュールを以下に転記します。

Sub ConvertFiles()
 ' このVBAは、Windows専用です。Macでは使えません。
    
    'On Error GoTo MyError
    On Error Resume Next
 
    Dim buf As String
    Dim cnt As Long
    Dim numConvert As Integer
    Dim extImport, extExport As String
    
    ' 「1.変換方法」の取得
    ' 「指定内容」のワークシート
    Dim wsSelectedItems As Worksheet
    Set wsSelectedItems = Worksheets("指定内容")
    ' 「変換方法」の取得
    numConvert = wsSelectedItems.Cells(1, 2)
    
    If numConvert = 1 Then
        extImport = "xls"
        extExport = "xlsx"
    Else
        extImport = "xlsx"
        extExport = "xls"
    End If
    

    ' 「2.フォルダ指定-インポート」「3.フォルダ指定-エクスポート」の取得
    Dim pathImport, pathExport As String
    pathImport = ActiveSheet.TextBox_FolderImport.Text & "\"
    pathExport = ActiveSheet.TextBox_FolderExport.Text & "\"
    
    
    ' 4.変換実行
    buf = Dir(pathImport & "*." & extImport)
    
    ' ファイル名格納用の配列
    Dim arr() As String
        
    Do While buf <> ""
        If LCase(buf) Like "*." & extImport Then
            cnt = cnt + 1
            ' wsFileNames.Cells(cnt, 2) = buf
            ' 配列に代入
            ReDim Preserve arr(1 To cnt)
            arr(cnt) = buf
        End If
        
        buf = Dir()
        
    Loop
    
    ' 取得したファイルを開く
    Dim fileImport As Workbook
    ' エクスポートするファイル名
    Dim fileExport As String
    
    If cnt > 0 Then
    
        ' 開く  https://www.excelspeedup.com/workbookopen/
        ' 閉じる    https://excel-ubara.com/excelvba5/EXCELVBA217.html
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
        For i = 1 To cnt
            Set fileImport = Workbooks.Open(pathImport & arr(i))
            ' 保存するファイル名を作成
            If extExport = "xls" Then
                fileExport = Mid(arr(i), 1, Len(arr(i)) - 5) & ".xls"
                '   名前を付けて保存    https://www.sejuku.net/blog/67491
                fileImport.SaveAs Filename:=pathExport & fileExport, FileFormat:=xlExcel8
            Else
                fileExport = Mid(arr(i), 1, Len(arr(i)) - 4) & ".xlsx"
                '   名前を付けて保存    https://www.sejuku.net/blog/67491
                fileImport.SaveAs Filename:=pathExport & fileExport, FileFormat:=xlOpenXMLWorkbook
            End If
            

            
            fileImport.Close savechanges:=False
        Next i
        Application.ScreenUpdating = True
    End If
    
    ' 完了処理
    MsgBox "処理が完了しました。" & cnt & "個"
    
    Exit Sub
    
MyError:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "エラーが発生しました。" & vbCrLf & Err.Description, vbExclamation


End Sub