先日、自分のHTML日記のURLをLINEに貼り付けて、友人に公開しようとしたら、
文字化けて読めないことが発覚。
どうやら、文字エンコーディング指定を記載していなかったことが原因っぽい。
通常のブラウザだと、結構自動で判別してくれるから、顕在化しないんだけど、
LINEのブラウザはおバカっぽいな！
などと、LINEのせいにしつつも、HTMLのお作法的にはイマイチなので、
ちょっと修正してみることに。
で、せっかくなので、他に対応したかったことも含めて、
前に紹介したExcelマクロを少し改造して、対応してみます。
ただし、前回同様、無駄に長いだけで大した面白みもないので、それでも良い方だけ先にお進みください。（ｗ
まずは、要求事項とその実現方法を整理してみる。
| # | 要求事項 | 実現方法 |
|---|---|---|
| 1 | LINEのブラウザでも文字化けなく表示したい。 | TITLEタグの下に文字エンコーディング指定のMETAタグを挿入する。 |
| 2 | はてなブログっぽく、日付タイトルをクリックしたらその日の日記に飛びたい。 | 日付タイトルにHREF属性を付けたAタグを挿入する。 |
| 3 | #2において、一部赤色のフォントがあるため、リンクの文字修飾はOFFにしたい。 | Aタグにはstyle属性を付ける。 |
これを対応前と対応後の成果物イメージで記載すると、こんな感じ。
（※上略） <HEAD> <TITLE>ちょぉ不定期日記 2000/04</TITLE> </HEAD> （※中略） <A NAME="20000430"><FONT SIZE=6><B>2000年4月30日(日)</B></FONT><BR></A> <BR> マリンメッセにコミケ襲撃。コミケについてはさして特筆することはなし。<BR> 一つ言えることは、使ったお金は入場料だけということくらいか･･･。<BR> （※中略） <HR> <A NAME="20000427"><FONT SIZE=6><B>2000年4月27日(木)</B></FONT><BR></A> <BR> 今日はゼミあったんで、サークル休んだ。<BR> ちゅーか、今日のこと誰も教えてくれない。電話くらいあっても良いと思うんだけどな〜。<BR> （※下略）
↓修正後
（※上略） <HEAD> <TITLE>ちょぉ不定期日記 2000/04</TITLE> <META http-equiv="Content-Type" content="text/html; charset=Shift_JIS" /> </HEAD> （※中略） <A NAME="20000430" HREF="#20000430" style="color:white;text-decoration:none"><FONT SIZE=6><B>2000年4月30日(日)</B></FONT><BR></A> <BR> マリンメッセにコミケ襲撃。コミケについてはさして特筆することはなし。<BR> 一つ言えることは、使ったお金は入場料だけということくらいか･･･。<BR> （※中略） <HR> <A NAME="20000427" HREF="#20000427" style="color:white;text-decoration:none"><FONT SIZE=6><B>2000年4月27日(木)</B></FONT><BR></A> <BR> 今日はゼミあったんで、サークル休んだ。<BR> ちゅーか、今日のこと誰も教えてくれない。電話くらいあっても良いと思うんだけどな〜。<BR> （※下略）
で、これを実現するために、組んだマクロがこんな感じ。
Sub Diary_Conv2() Dim intFIn, intFOut As Integer Dim strRec As String Dim strFileName As String Dim lngStPt, lngEdPt As Long Dim strName, strColor As String '先頭のファイル名の取得 strFileName = Dir(ThisWorkbook.Path & "\diary\", vbNormal) 'ファイルが見つからなくなるまで繰り返す Do While strFileName <> vbNullString 'HTMLファイル以外は読み飛ばす If InStr(1, strFileName, ".html") > 0 Then '入力ファイルをOPEN intFIn = FreeFile Open ThisWorkbook.Path & "\diary\" & strFileName For Input As #intFIn '出力ファイルをOPEN intFOut = FreeFile Open ThisWorkbook.Path & "\output\" & strFileName For Output As #intFOut 'ファイルのEOFまで繰り返す Do Until EOF(intFIn) '改行までをレコードとして読み込む Line Input #intFIn, strRec '文字エンコーディング指定を追加 If InStr(1, strRec, "</TITLE>") > 0 Then strRec = strRec & vbCrLf & "<META http-equiv=" & Chr(34) & "Content-Type" & Chr(34) _ & " content=" & Chr(34) & "text/html; charset=Shift_JIS" & Chr(34) & " />" End If '日付タイトルの部分の場合のみレコードを編集 If InStr(1, strRec, "<FONT SIZE=6><B>") > 0 And _ InStr(1, strRec, "年") > 0 And InStr(1, strRec, "月") > 0 Then 'NAMEの値を取得 lngStPt = InStr(1, strRec, Chr(34)) lngEdPt = InStr(lngStPt + 1, strRec, Chr(34)) strName = Mid(strRec, lngStPt + 1, lngEdPt - lngStPt - 1) 'Colorの値を取得 lngStPt = InStr(1, strRec, "COLOR=") + 6 If lngStPt = 6 Then strColor = "white" Else lngEdPt = InStr(lngStPt, strRec, ">") - 1 strColor = Mid(strRec, lngStPt, lngEdPt - lngStPt + 1) End If 'HREF属性を付与 strRec = Replace(strRec, "<A NAME=" & Chr(34) & strName & Chr(34), "<A NAME=" & Chr(34) & strName & Chr(34) & _ " HREF=" & Chr(34) & "#" & strName & Chr(34) & " style=" & Chr(34) & "color:" & strColor & ";text-decoration:none" & Chr(34)) End If 'レコードを出力 Print #intFOut, strRec Loop 'ファイルをCLOSE Close #intFIn Close #intFOut End If '次のファイル名を取得 strFileName = Dir() Loop End Sub
というわけで、無事にLINEのブラウザで参照が可能となりましたとさ。めでたしめでたし。（ｗ
ちなみに、前回同様、ココに載せたへっぽこマクロのソースは、別に他で好きに使っても構いませんが、
ダメ出しやバグ等の文句は受け付けませんのでご了承ください。（ｗ
