ポイントは、ADODB.Stream で UTF-8(BOMなし)で出力することと、ブラウザで HTML コードを確認したときに CSS 部分がわかりやすいように成形すること。table の生成コード自体はそれほど難しくなくて、それをどう見せるか、という CSS の生成が若干面倒くさい。必要なのはむしろ HTML の知識。
※ヘッダ行(項目行)のある CSV しか扱わないのなら、ヘッダのあるなしの切り分けは不要かもしれない。
この VBS ファイルは SendTo フォルダ(C:\Users\ユーザ名\AppData\Roaming\Microsoft\Windows\SendTo)に入れて、
[CSVファイル]右クリック →[送る]→[CSVtoHTML.vbs]選択とするのが便利。
CSVtoHTML.vbs
Option Explicit
Dim idHdr, startNum, arg, h4Str, htmlStr, htmlPath, msg, binData
Dim J, JJ
J = vbCrLf
JJ = J & J
idHdr = Msgbox("ヘッダ(項目行)ありですか?", vbYesNo)
If idHdr = vbYes Then startNum = 0 Else startNum = 1
msg = ""
With CreateObject("Scripting.FileSystemObject")
For Each arg In WScript.Arguments
If LCase(.GetExtensionName(arg)) <> "csv" Then
msg = msg & .GetFileName(arg) & J
Else
htmlStr = "<!DOCTYPE html>" & J & "<html lang='ja'>" & J
htmlStr = htmlStr & GetHtmlHead(.GetFileName(arg)) & GetHtmlBody(arg, startNum) & "</html>"
htmlPath = .BuildPath(.GetParentFolderName(arg), Replace(h4Str, ".csv", "_csv") & ".html")
'// UTF-8〔BOMなし〕で書き出し
With CreateObject("ADODB.Stream")
.Open
.Type = 2 '// 2:テキスト
.Charset = "utf-8"
.WriteText htmlStr
.Position = 0
.Type = 1 '// 1:バイナリ
.Position = 3
binData = .Read
.Close
.Open
.Write binData
.SaveToFile htmlPath, 2 '// 2:上書き
.Close
End With
CreateObject("WScript.Shell").Run Chr(34) & htmlPath & Chr(34), 0, True
End If
Next
End With
If msg <> "" Then MsgBox msg & J & "は CSVファイルではありません。"
'// <table>生成
Function GetHtmlTable(ByVal csv_path, ByVal start_num)
Dim hdrLineBegin, hdrLineBody, hdrLineEnd
Dim dataLineBegin, dataLineBody, dataLineEnd
Dim delim, n, lineStr, tableStr
hdrLineBegin = "<tr><th>"
hdrLineBody = "</th><th>"
hdrLineEnd = "</th></tr>"
dataLineBegin = "<tr><td>"
dataLineBody = "</td><td>"
dataLineEnd = "</td></tr>"
delim = ","
n = start_num: tableStr = ""
With CreateObject("Scripting.FileSystemObject").OpenTextFile(csv_path, 1, False, 0)
Do Until .AtEndOfStream
lineStr = .ReadLine
lineStr = Replace(lineStr, Chr(34), "")
If n = 0 Then
lineStr = hdrLineBegin & "No." & hdrLineBody & Replace(lineStr, delim, hdrLineBody) & hdrLineEnd
Else
lineStr = dataLineBegin & n & dataLineBody & Replace(lineStr, delim, dataLineBody) & dataLineEnd
End If
tableStr = tableStr & lineStr & J
n = n + 1
Loop
.Close
End With
GetHtmlTable = "<table>" & J & tableStr & J & "</table>"
End function
'// <h4>文字列生成
Function GetH4Str(ByVal csv_path)
Dim folderPath, preFix1, preFix2, csvName
With CreateObject("Scripting.FileSystemObject")
folderPath = .GetParentFolderName(csv_path)
preFix1 = .GetFolder(.GetParentFolderName(folderPath)).Name
If preFix1 = "" Then preFix1 = Replace(.GetDriveName(csv_path), ":", "")
preFix2 = .GetFolder(folderPath).Name
csvName = .GetFileName(csv_path)
End With
GetH4Str = preFix1 & "≫" & preFix2 & "≫" & csvName
End Function
'// <body>生成
Function GetHtmlBody(ByVal csv_path, ByVal start_num)
Dim htmlBody
h4Str = GetH4Str(csv_path)
htmlBody = "<body>" & J & "<h4>" & h4Str & "</h4>" & J
htmlBody = htmlBody & "<div class='tdiv'>" & J & GetHtmlTable(csv_path, start_num) & J & "</div>" & J
htmlBody = htmlBody & "<p class='copyright'>© " & Year(Date) & " istoyo.</p>" & J
htmlBody = htmlBody & "</body>" & J
GetHtmlBody = htmlBody
End Function
'// <head>生成
Function GetHtmlHead(ByVal title_str)
Dim tb, tb2, tb3, headStr
tb = String(4, " ")
tb2 = tb & tb
tb3 = tb & tb2
headStr = "<head>" & J
headStr = headStr & tb & "<meta http-equiv='Content-Type' content='text/html; charset=UTF-8'>" & J
headStr = headStr & tb & "<style>" & J
headStr = headStr & tb2 & ".tdiv {" & J
headStr = headStr & tb3 & "top: 80px;" & J
headStr = headStr & tb3 & "width: 98%;" & J
headStr = headStr & tb3 & "height: 450px;" & J
headStr = headStr & tb3 & "position: fixed;" & J
headStr = headStr & tb3 & "overflow: scroll;" & J
headStr = headStr & tb2 & "}" & JJ
headStr = headStr & tb2 & "table {" & J
headStr = headStr & tb3 & "border-collapse: collapse;" & J
headStr = headStr & tb3 & "font-size: 75%;" & J
headStr = headStr & tb3 & "margin-right: 2em;" & J
headStr = headStr & tb3 & "margin-bottom: 2em;" & J
headStr = headStr & tb2 & "}" & JJ
headStr = headStr & tb2 & "th,td {" & J
headStr = headStr & tb3 & "white-space: nowrap;" & J
headStr = headStr & tb3 & "border: solid 1px #000000;" & J
headStr = headStr & tb3 & "padding: 0.2em 0.5em;" & J
headStr = headStr & tb2 & "}" & JJ
headStr = headStr & tb2 & "th {" & J
headStr = headStr & tb3 & "color: rgb(99,37,35);" & J
headStr = headStr & tb3 & "background-color: rgb(235,235,235);" & J
headStr = headStr & tb3 & "position: sticky;" & J
headStr = headStr & tb3 & "top: 0;" & J
headStr = headStr & tb3 & "z-index: 1;" & J
headStr = headStr & tb2 & "}" & JJ
headStr = headStr & tb2 & "th:first-child {" & J
headStr = headStr & tb3 & "z-index: 2;" & J
headStr = headStr & tb3 & "position: sticky;" & J
headStr = headStr & tb3 & "left: 0;" & J
headStr = headStr & tb2 & "}" & JJ
headStr = headStr & tb2 & "td {" & J
headStr = headStr & tb3 & "text-align: left;" & J
headStr = headStr & tb2 & "}" & JJ
headStr = headStr & tb2 & "td:first-child {" & J
headStr = headStr & tb3 & "position: sticky;" & J
headStr = headStr & tb3 & "left: 0;" & J
headStr = headStr & tb3 & "color: white;" & J
headStr = headStr & tb3 & "background-color: rgb(100, 100, 100);" & J
headStr = headStr & tb2 & "}" & JJ
headStr = headStr & tb2 & "p {" & J
headStr = headStr & tb3 & "position:fixed;" & J
headStr = headStr & tb3 & "top: 530px;" & J
headStr = headStr & tb3 & "font-size: smaller;" & J
headStr = headStr & tb2 & "}" & JJ
headStr = headStr & tb2 & ".copyright {" & J
headStr = headStr & tb3 & "text-align: right;" & J
headStr = headStr & tb3 & "margin-top: 1em;" & J
headStr = headStr & tb3 & "padding: 0.2em;" & J
headStr = headStr & tb3 & "font-size: 70%;" & J
headStr = headStr & tb2 & "}" & J
headStr = headStr & tb & "</style>" & J
headStr = headStr & tb & "<title>" & title_str & "</title>" & J
headStr = headStr & "</head>" & J
GetHtmlHead = headStr
End Function
<参考サイト>
VBAでテキストファイルをUTF-8(BOMなし)で書き出す