こんにちは、Ryoです。
今では.xlsxがほぼ通常の拡張子であるものの、場合によってはExcelの97/2003形式である.xlsを使っていることもあるかと思います。
この場合VBAで処理する都合上、形式が違うことによりエラーが出ることがありますので変換して.xlsx形式に変えてしまった方が良いこともありますので、今回はフォルダ内の.xlsを変換するサンプルコードを書いてみたいと思います。
1.サンプルコード
このサンプルでは「Testフォルダ」にある.xls拡張子のつくファイルを抽出し、.xlsxに置換して元の.xlsファイルを削除するものです。
先ずフォルダ内に以下のファイルがあります。
これらのファイルを.xlsx拡張子に一括で変換するサンプルコードは以下になります。
Sub Sample1()
Application.ScreenUpdating = False
Dim strArray() As String '.xls拡張子ファイルの格納用
Dim strFile, strBook, Path As String '保存対象フォルダ内のファイル読込用
Dim r As Integer
Path = "C:\Users\user\Desktop\Testフォルダ\"
strFile = Dir(Path & "\" & "*.xls") '保存対象フォルダ内の「.xls]ファイル有無を検索
r = 0
Do While strFile <> "" '.xlsファイルが見つかった場合の処理
'小文字変換/文字列右側から4文字が.xlsの場合の処理
If LCase(Right(strFile, 4)) = ".xls" Then
ReDim Preserve strArray(r) 'strArray配列の再宣言（preserveは省略可）
strArray(r) = strFile
r = r + 1
End If
strFile = Dir()
Loop
If Not Not strArray Then 'strArray配列が空かデータ有かの条件分岐
For r = 0 To UBound(strArray)
With Workbooks.Open(Path & strArray(r)) '.xlsファイルを開く
'格納したファイル名から拡張子を取り除く
strBook = Left(strArray(r), InStrRev(strArray(r), ".") - 1)
If Dir(Path & strBook & ".xlsx") = "" Then
'保存対象に.xlsxが存在しない場合は格納した名前＋.xlsxにて保存する
.SaveAs Filename:=Path & strBook & ".xlsx", FileFormat:=xlWorkbookDefault
Else '.xls以外に.xlsxまで存在している場合はフォルダ内の整理が必要と判断し、処理中止
MsgBox "同名Fileで.xlsと.xlsxが混在していますので、" & vbCrLf & _
"フォルダ内整理後に再度実行してください", vbCritical
Exit Sub
End If
.Close savechanges:=False '.xls⇒.xlsx変換完了後、ファイルを閉じる
End With
Kill Path & strArray(r) '保存対象フォルダに残った.xlsファイルを削除する
Next
End If
Erase strArray()
Application.ScreenUpdating = True
MsgBox "「.xls」ファイルを「.xlsx」に置換しました", vbInformation
End Sub
このサンプルコードを実行するとフォルダ内のファイルが以下の様に変換されます。
2.コード解説
使っているメソッドなどの詳細な解説は割愛して概要を説明します。
動作を大別すると、
「フォルダ内の.xlsファイルを検索して、ファイル名を配列に格納」
「ファイル名に.xlsx拡張子を付けて保存」
「フォルダに残っている.xls拡張子のファイルを削除」
この3つになります。
◆フォルダ内のファイル検索～配列格納
Path = "C:\Users\user\Desktop\Testフォルダ\"
strFile = Dir(Path & "\" & "*.xls") '保存対象フォルダ内の「.xls]ファイル有無を検索
r = 0
Do While strFile <> "" '.xlsファイルが見つかった場合の処理
'小文字変換/文字列右側から4文字が.xlsの場合の処理
If LCase(Right(strFile, 4)) = ".xls" Then
ReDim Preserve strArray(r) 'strArray配列の再宣言（preserveは省略可）
strArray(r) = strFile
r = r + 1
End If
strFile = Dir()
Loop
先ずPath変数に変換対象のフォルダパスを指定します。
その後Dir関数でフォルダ内の.xlsファイルを検索し、見つかったファイル数分Do～Loopで処理を実行し、対象数分を配列の要素数にする為、ReDimで再宣言を行っています。
Dir関数や配列のRedimについては別記事で解説していますので、よろしければ参照ください。
◆ファイル名に.xlsx拡張子を付けて保存
With Workbooks.Open(Path & strArray(r)) '.xlsファイルを開く
'格納したファイル名から拡張子を取り除く
strBook = Left(strArray(r), InStrRev(strArray(r), ".") - 1)
If Dir(Path & strBook & ".xlsx") = "" Then
'保存対象に.xlsxが存在しない場合は格納した名前＋.xlsxにて保存する
.SaveAs Filename:=Path & strBook & ".xlsx", FileFormat:=xlWorkbookDefault
Else '.xls以外に.xlsxまで存在している場合はフォルダ内の整理が必要と判断し、処理中止
MsgBox "同名Fileで.xlsと.xlsxが混在していますので、" & vbCrLf & _
"フォルダ内整理後に再度実行してください", vbCritical
Exit Sub
End If
.Close savechanges:=False '.xls⇒.xlsx変換完了後、ファイルを閉じる
End With
この部分では先ずファイルを開き、ファイル名＋.xlsx拡張子を付けて標準形式で保存を実行していますが、仮に同名で.xlsxファイルが既に存在している場合は警告表示し処理中断する形となっています。
◆フォルダ内に残る.xlsファイルの削除
Kill Path & strArray(r)
この部分で配列に格納されている元のファイル名（.xls)を順次削除します。
実行すると跡形もなく消えますから、実際の処理を行う上ではバックアップを取るなど万全を期してから試されると良いと思います。
ファイル操作についても別記事で解説していますので、よろしければご参照ください。
3.まとめ
一括で変換しようとする場合は、先ずDir関数でファイルを検索＆抽出し、対象ファイル名を配列に格納して、ファイルを開き拡張子を変えて保存します。
その後、不要となる旧ファイルは削除して、変換された.xlsxが残るという形になります。
このサンプルのような形で.xlsを変換することが出来ますから、一つの方法として知っておくと便利ではないかと思いますので、機会があればご活用ください。
但し、変換することでファイルの内容に弊害が起きることがありますから事前に確認するなど行ってからが良いと思いますので、使用にはご注意くださいね。
以上、フォルダ内の.xlsを.xlsxに一括で変換する方法についてでした！
今回の記事が何かの参考になれば幸いです。
Ryo
