Skip to content

Instantly share code, notes, and snippets.

@Neos21

Neos21/ThisWorkbook.vba

Last active May 13, 2019
Embed
What would you like to do?
このブックがあるディレクトリの xls ファイルを xlsx 形式で保存する
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
@Neos21

This comment has been minimized.

Copy link
Owner Author

@Neos21 Neos21 commented May 13, 2019

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment