前の記事はこちら
『 HTMLファイルの目次を作る』
今回はファイル名をリンクに表示するのではなく
HTMLファイル内のタイトルをリンクに表示したいと思います。
タイトルとは<TITLE>と</TITLE>で囲まれた間の文字です。
もしタイトルがなければ
ファイル名をリンクの文字にします。
あと更新日時も付け加えます。
これについてはこちらの記事も参照してください。
『 画像一覧のHTMLファイル作成 』
タイトルを取得するために
HTMLファイルをテキストファイルとして開きます。
そのファイルの文字列から「<TITLE>」と「</TITLE>」が
何文字目かを調べます。
これにはInstr関数を使用します。
たとえば「<TITLE>」と「</TITLE>」がそれぞれ
15文字目と37文字目だったとします。
そしてタイトルが次のようだとします。
<TITLE>画像一覧のHTMLファイルを作成</TITLE>
一番最初の<が15文字目、
終了タグの<が37文字目です。
「画像一覧のHTMLファイルを作成」だけを
ファイルの文字列から取り出すには、
ファイルの文字列の(15+7)番目の文字列から
(37-15-7)文字数だけ取り出せばいいです。
これにMid関数を使います。
変数MyPathに
HTMLファイルの目次を生成したいフォルダを入れてください。
コードはこちら
HTMLファイルの目次を作る2のコード：Sub macro110430a()
Dim MyPath As String, MyFile As String
Dim MyHTML As String
Dim i As Integer
Dim fs, f As Object
Dim dlm As Date '.DateLastModified
Dim ftext As String, ftext2 As String
'ファイル全文文字列、その大文字化
Dim num1 As Long, num2 As Long
'タイトル開始、終了文字番目
Dim strTitle As String 'タイトル文字列
MyHTML = "<HTML><HEAD><STYLE type='text/css'>" _
& "SPAN.dlm{font-size:smaller}</STYLE>" _
& "</HEAD><BODY>"
'フォルダを指定する
MyPath = "フォルダへのパス\"
'ファイルの有無を確認
With Application.FileSearch
.NewSearch
.LookIn = MyPath
'
.Filename = "*.htm*"
If .Execute() > 0 Then
MsgBox .FoundFiles.Count & _
" 個のファイルが見つかりました。"
Set fs = CreateObject("Scripting.FileSystemObject")
For i = 1 To .FoundFiles.Count
'最終更新日取得
Set f = fs.GetFile(.FoundFiles(i))
dlm = f.DateLastModified
'タイトル等取得
Set f = fs.OpenTextFile(.FoundFiles(i), 1, False, -2)
ftext = f.readall
ftext2 = UCase(ftext)
num1 = InStr(ftext2, "<TITLE>")
num2 = InStr(ftext2, "</TITLE>")
If num1 <> 0 Then
'タイトルがある
strTitle = Mid(ftext, num1 + 7, num2 - num1 - 7)
Else
'タイトルがない
'ファイル名にする
strTitle = Dir(.FoundFiles(i))
End If
f.Close
MyHTML = MyHTML _
& "<A target=" & Chr(34) & "main" & Chr(34) _
& " href =" & Chr(34) _
& Dir(.FoundFiles(i)) & Chr(34) & ">" _
& strTitle & "</A> <SPAN class=dlm>" _
& "(" & Format(dlm, "yyyy/mm/dd hh:ss") & ")" _
& "</SPAN><BR/>" & Chr(10)
Next i
Else
MsgBox "検索条件を満たすファイルはありません。"
End If
End With
MyHTML = MyHTML & "</BODY></HTML>"
'HTML形式のファイルを生成
Dim a As Object
Set a = fs.CreateTextFile(MyPath & "menu110430.html", True)
a.WriteLine (MyHTML)
a.Close
'フレームのHTML生成
MyHTML = "<HTML><FRAMESET cols='70%,30%'>" & _
"<FRAME name='main' src='menu110430.html'>" & _
"<FRAME name='menu' src='menu110430.html'>" & _
"</FRAMESET></HTML>"
Set a = fs.CreateTextFile(MyPath & "frame110430.html", True)
a.WriteLine (MyHTML)
a.Close
End Sub |
frame110430.htmlを開いたときに
文字化けしているリンクの文字があるときは
リンク先のファイルを
ANSIかunicodeで上書き保存してください。
それから
frame110430.htmlとmenu110430.htmlを削除してから
再度実行してみてください。
コメント