Instantly share code, notes, and snippets.

Embed
What would you like to do?
UTF-8 の BOM を削除する VBScript
Option Explicit
' ==================================================================================
' UTF-8 のファイルのBOMを削除するVBScript
' ファイルをドラッグ&ドロップして利用する。
' 2012/01/14 Nakamura, Tomohiro
' This Software is under CC0
' ADODB の為、要Excel
' ==================================================================================
Dim adTypeBinary, adTypeText, adSaveCreateOverWrite
adTypeBinary = 1
adTypeText = 2
adSaveCreateOverWrite = 2
Sub Main
Dim msg, filePath
If (WScript.Arguments.Count = 0) Then
msg = "ファイルをドラッグ&ドロップしてください。"
Else
filePath = WScript.Arguments(0)
DeleteUTF8Bom filePath
msg = "下記のファイルについて UTF-8 BOM有りの場合は削除しました。" & vbCrLf _
& """" & filePath & """"
End If
MsgBox msg
End Sub
' UTF-8 のファイルについて BOM の削除をする
Sub DeleteUTF8Bom(filePath)
Dim inputFile, tmp, data, outputFile
If CheckBom(filePath) Then
Set inputFile = WScript.CreateObject("ADODB.Stream")
inputFile.Type = adTypeBinary
inputFile.Open
inputFile.LoadFromFile filePath
inputFile.Position = 3
data = inputFile.Read(-1)
inputFile.Close
Set outputFile = WScript.CreateObject("ADODB.Stream")
outputFile.Type = adTypeBinary
outputFile.Open
outputFile.Write data
outputFile.SaveToFile filePath, adSaveCreateOverWrite
outputFile.Close
End If
End Sub
' UTF-8 のファイルについて BOM 有/無の判定をする
Function CheckBom(filePath)
Dim inputFile, data, bin
bin = vbNullString
Set inputFile = WScript.CreateObject("ADODB.Stream")
inputFile.Type = adTypeBinary
inputFile.Open
inputFile.LoadFromFile filePath
inputFile.Position = 0
If inputFile.Size > 2 Then
data = inputFile.Read(3)
bin = Hex(AscB(MidB(data, 1, 1))) _
& Hex(AscB(MidB(data, 2, 1))) _
& Hex(AscB(MidB(data, 3, 1)))
End If
inputFile.Close
CheckBom = (bin = "EFBBBF")
End Function
Main
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment