EXCEL VBA

Excel-VBA UTF8→SJIS変換 バッチを生成し実行する

EXCEL VBA

こんにちは！ 健史です。

UTF8のファイルをSJISに変換する処理をVBAで作成しました。


SJISに一括変換することに加え、ポイントは、

・VBAでバッチファイルを生成し、実行する
・生成したバッチファイルの中身は、PowerShellコマンドを実行する

ことです。

また、バッチファイルを生成せずにVBAからPowerShellコマンドを実行する方法も紹介します。

スポンサーリンク

概要

処理イメージ

・設定シート

設　定　項　目	設　定　値	備　考
入力フォルダ	C:\TEMP01\UTF8-IN	
出力ファルダ	C:\TEMP01\UTF8-SJIS	
検索レベル	M	S,M
バッチファイル名	UTF8_CONV.Bat	
バッチファイルを削除		1を設定
※1検索レベル		
 S:検索フォルダのみ、M:下位サブフォルダまで		
		
powershell -NoProfile -ExecutionPolicy Unrestricted -Command "& { get-content -Encoding UTF8 '		
C:\TEMP01\UTF8-IN	←入力ファイル名	
' | Set-Content '		
C:\TEMP01\UTF8-SJIS	←出力ファイル名	
'}"

ドラッグ＆コピー後にExcelに貼り付けるとき、[形式を選択して貼り付ける]-[テキスト]で貼り付けます。(セル[A1]で[右クリック]、[形式を選択して貼り付ける]-[テキスト])を指定します。


尚、[powershell～]・[' | Set-Content ']・['}"]の部分は、プログラムで参照していますので、漏らさずコピーします。

VBAでバッチファイルなどを作成するとき、決まっている文言はプログラム内にオンコーディングするのではなく、シート上に設定しておき参照・取り込むようにしています。

「どこに何を置くのか」シートを活用したプログラム全体として見やすくなりますし、作成時のテストや変更もしやすいです。

・フォルダとファイル
＜入力フォルダ＞

＜出力フォルダ＞

出力フォルダ内のファイルはSJIS形式になっています。

また、バッチファイルが作成されています。

処理概要

1.UTF-8形式のテキストファイルを格納しているフォルダを設定する
2.[1.]をSJIS形式に変換したファイルを格納するフォルダを設定する
3.[1.]の対象にサブフォルダまで含めるかを設定する
　ただし、出力フォルダ内には同じフォルダ構成は作成しない
4.処理内で生成するバッチファイル名を設定する
5.生成したバッチファイルを処理後に残しておくか削除するか設定する
6.処理を実行する


[6.処理を実行する]の概要です。
1).[1.]のフォルダからファイル名をシート２に取得する
2).[1.][2.]]のフォルダ情報、および、取得したファイル名から、UTF-8→SJIS変換のバッチファイルを[2.]のフォルダ内に生成する
3).バッチファイルを実行する
4).[4.]の設定によりバッチファイルを削除する(削除しない設定の場合は削除しない)

プログラム

以下のプログラムをVBAエディタで貼り付ける場合の重要な注意点です。

VBAエディタを起動したら、[ツール(T)]-[参照設定(R)]から以下にチェックを入れます。

Windows Script Host Object Model

バッチファイルを起動するために「WshShell」クラスというものを使用するために必要です。
(バッチファイルを起動しないのであれば「Windows Script Host Object Model」へのチェックは不要です)


プログラムは保存できますが、チェックを入れないと処理を実行できません。エラーになります。

一旦保存した後にプログラムを修正しようとファイルを開き、Alt+F8を押下しても「マクロ」画面で[編集]ボタンを押せません。
その場合は、
1.「マクロ」画面を[キャンセル]で閉じる
2.Excel画面から[開発(L)]-[Visual Basic(V)]からVBAエディタを起動する
3.[ツール(T)]-[参照設定(R)]から「Windows Script Host Object Model」にチェックを入れる

上記[1.]でプログラムが開かない場合は[2.]以降で解消すると考えていますが、開きたい場合は
「VBAエディタの左上画面：プロジェクト-VBAProjectのツリー構造になっている[標準モジュール]から'Module1','Module2'・・・をクリックする」
で表示されるでしょう。

'－－－－－　変数定義　－－－－－
    Const cnsDIR = "\*.*"
    Dim ix2, ix2_max As Long
    Dim strPath, strPath2, strFilename, strFindlvl, strBat, strDel, strTxt, strPathBat As String
    Dim objWSH As WshShell
'－－－－－　レベル：０　－－－－－
'メイン処理
Sub MAIN00()
'初期処理
    Select Case Sheets.Count   'シート２，シート３を追加し忘れた時の対応
    Case 1
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ワーク"
    End Select
    Sheets(2).Cells.Clear
    strPath = Sheets(1).Cells(2, 2)
    strPath2 = Sheets(1).Cells(3, 2)
    strFindlvl = Sheets(1).Cells(4, 2)
    strBat = Sheets(1).Cells(5, 2)
    strDel = Sheets(1).Cells(6, 2)
    strPathBat = strPath2 & "\" & strBat
'入力項目チェック
    Call SUB01_INPUT_CHECK
'フォルダからフィル名をシート２に取得
    ix2 = 0
    Call SUB99_DIRLIST(strPath)
    ix2_max = ix2
'バッチファイルの生成
    Call SUB01_BAT_MAKE
''バッチファイルを実行
    Set objWSH = New WshShell
    Call objWSH.Run(strPathBat, WaitOnReturn:=True)
'バッチファイルの削除指定により削除
    If strDel = 1 Then
        Kill strPathBat
    End If
'
    ThisWorkbook.Save
    MsgBox "処理終了！"
End Sub
'－－－－－　レベル：１　－－－－－
'設定シート項目チェック
Sub SUB01_INPUT_CHECK()
    If Dir(strPath, vbDirectory) = "" Then
        MsgBox "入力フォルダがありません！"
        End
    End If
'
    If Dir(strPath2, vbDirectory) = "" Then
        MsgBox "出力フォルダがありません！"
        End
    End If
'
    Select Case strFindlvl
    Case "S", "M"
    Case Else
         MsgBox "検索レベルが間違っています！"
         End
    End Select
'
    Select Case strDel
    Case "", "1"
    Case Else
         MsgBox "バッチファイルの削除指定が間違っています！"
         End
    End Select
End Sub
Sub SUB01_BAT_MAKE()
    Open strPathBat For Output As #1
    For ix2 = 1 To ix2_max
        strTxt = Sheets(1).Cells(10, 1)
        strTxt = strTxt & Sheets(2).Cells(ix2, 3)
        strTxt = strTxt & Sheets(1).Cells(12, 1)
        strTxt = strTxt & strPath2 & "\" & Sheets(2).Cells(ix2, 2)
        strTxt = strTxt & Sheets(1).Cells(14, 1)
        Print #1, strTxt
    Next
    Close #1
End Sub
'－－－－－　レベル：９９　－－－－－
'ディレクトリリスト：シート２に取得
Sub SUB99_DIRLIST(ByVal Path As String)
    Dim objFile As Object
    strFilename = Dir(Path & cnsDIR)
    Do While strFilename <> ""
        ix2 = ix2 + 1
        Sheets(2).Cells(ix2, 1) = Path
        Sheets(2).Cells(ix2, 2) = strFilename
        Sheets(2).Cells(ix2, 3) = Path & "\" & strFilename
        strFilename = Dir()
    Loop
'検索レベルがシングルのときは、取得終了
    Select Case strFindlvl
    Case "S"
        Exit Sub
    End Select
'検索レベルがマルチのとき、サブフォルダまで検索
    With CreateObject("Scripting.FileSystemObject")
        For Each objFile In .GetFolder(Path).SubFolders
            Call SUB99_DIRLIST(objFile.Path)
        Next objFile
    End With
End Sub

VBAからPowerShellを実行

・設定シート

設　定　項　目	設　定　値	備　考
入力フォルダ	C:\TEMP01\SJIS-CONV-IN	
出力ファルダ	C:\TEMP01\SJIS-CONV-OUT	
検索レベル	M	S,M
		
		
※1検索レベル		
 S:検索フォルダのみ、M:下位サブフォルダまで		
		
get-content -Encoding UTF8 '		
C:\TEMP01\SJIS-CONV-IN\xx.txt	←入力ファイル名	
' | Set-Content '		
C:\TEMP01\SJIS-CONV-OUT\xx.txt	←出力ファイル名	
'

・プログラム

#If VBA7 And Win64 Then
'64Bit版用
  Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
'32Bit版用
  Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
'－－－－－　変数定義　－－－－－
    Const cnsDIR = "\*.*"
    Dim ix2, ix2_max As Long
    Dim strPath, strPath2, strFilename, strFindlvl, strResult, strTxt As String
'－－－－－　レベル：０　－－－－－
'メイン処理
Sub MAIN00()
'初期処理
    Select Case Sheets.Count   'シート２，シート３を追加し忘れた時の対応
    Case 1
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = "ワーク"
    End Select
    Sheets(2).Cells.Clear
    strPath = Sheets(1).Cells(2, 2)
    strPath2 = Sheets(1).Cells(3, 2)
    strFindlvl = Sheets(1).Cells(4, 2)
'入力項目チェック
    Call SUB01_INPUT_CHECK
'フォルダからフィル名をシート２に取得
    ix2 = 0
    Call SUB99_DIRLIST(strPath)
    ix2_max = ix2
'コマンドの生成
    Call SUB01_COMMAND_MAKE_EXEC
'
    ThisWorkbook.Save
    MsgBox "処理終了！"
End Sub
'－－－－－　レベル：１　－－－－－
'設定シート項目チェック
Sub SUB01_INPUT_CHECK()
    If Dir(strPath, vbDirectory) = "" Then
        MsgBox "入力フォルダがありません！"
        End
    End If
'
    If Dir(strPath2, vbDirectory) = "" Then
        MsgBox "出力フォルダがありません！"
        End
    End If
'
    Select Case strFindlvl
    Case "S", "M"
    Case Else
         MsgBox "検索レベルが間違っています！"
         End
    End Select
End Sub
Sub SUB01_COMMAND_MAKE_EXEC()
    For ix2 = 1 To ix2_max
        strTxt = Sheets(1).Cells(10, 1)
        strTxt = strTxt & Sheets(2).Cells(ix2, 3)
        strTxt = strTxt & Sheets(1).Cells(12, 1)
        strTxt = strTxt & strPath2 & "\" & Sheets(2).Cells(ix2, 2)
        strTxt = strTxt & Sheets(1).Cells(14, 1)
        Sheets(2).Cells(ix2, 4) = strTxt
        strResult = ExecPowerShell(strTxt)
        Sheets(2).Cells(ix2, 5) = strResult
    Next
End Sub
'－－－－－　レベル：９９　－－－－－
'ディレクトリリスト：シート２に取得
Sub SUB99_DIRLIST(ByVal Path As String)
    Dim objFile As Object
    strFilename = Dir(Path & cnsDIR)
    Do While strFilename <> ""
        ix2 = ix2 + 1
        Sheets(2).Cells(ix2, 1) = Path
        Sheets(2).Cells(ix2, 2) = strFilename
        Sheets(2).Cells(ix2, 3) = Path & "\" & strFilename
        strFilename = Dir()
    Loop
'検索レベルがシングルのときは、取得終了
    Select Case strFindlvl
    Case "S"
        Exit Sub
    End Select
'検索レベルがマルチのとき、サブフォルダまで検索
    With CreateObject("Scripting.FileSystemObject")
        For Each objFile In .GetFolder(Path).SubFolders
            Call SUB99_DIRLIST(objFile.Path)
        Next objFile
    End With
End Sub

'**************************************************
'PowerShellの実行（Execコマンド使用バージョン）
'**************************************************
Private Function ExecPowerShell(cmdStr As String) As String
' WshShellオブジェクト
    Dim objWSH As Object
    Set objWSH = CreateObject("Wscript.shell").Exec("powershell -NoLogo -ExecutionPolicy RemoteSigned -Command " & cmdStr)
' ジョブが実行中(0)の間は、スリープしながら完了（1）まで待つ
    Do While objWSH.Status = 0
        ' 100ミリ秒
        Sleep 100
    Loop
' 標準出力取得 ディレクトリリストなどを取得する場合には入っている
    ExecPowerShell = objWSH.StdOut.ReadAll
 End Function

最後に

バッチ起動とVBAからPowerShell実行において、参考にさせて頂いたサイトです。

PowerShell VBAでPowerShellを実行して結果を取得する（Exec編）【初実験編07】 | システムトラスト 技術ブログ
Excel（VBA）からPowerShellを実行して、結果をセルに出力してみる VBAからPowerShellを実行するには、WshShellオブジェクトを使用しますが、Exec...
it-engineer-info.com


参考にして頂ければと思います。

EXCEL VBA
スポンサーリンク
－ 面白かったらシェアお願いします！ －
健史をフォローする
健史
自分で改善
スポンサーリンク

コメント