VBAでウェブページを大量生産したのでメモ【Excel/VBA】

Excel

ExcelのセルデータをHTMLファイルに差し込んで大量のウェブページを作成したい時、いちいちセルからコピペするのは大変です！
今回、VBAを使ってHTMLファイルを大量生産する方法を調べました。

いろいろなサイトのコードを参考にさせてもらい、何とか動作しました。感謝！

VBAで作成するHTMLファイルの確認

ページの構造は単純で、こんな感じのプロフィールページが大量にある感じです。

言葉だと説明が難しいので、まずはこちらのサンプルをご確認ください。

VBAでExcelのデータを差し込んだHTMLを大量生産する-プロフィール_01|えむ家のメモ帳
m-kenomemo.com

HTMLファイルに差し込むExcelデータはこんな感じ

Excelデータはこんな感じで、左からID、名前、アバターの画像URL、性別、職業、文章が並んでいます。
これらのデータを書き出すHTMLファイルに差し込んでいきます。

ダミーデータはこちらのサイトで生成しました。

Mockaroo - Random Data Generator and API Mocking Tool | JSON / CSV / SQL / Excel
A free test data generator and API mocking tool - Mockaroo lets you create custom CSV, JSON, SQL, and Excel datasets to ...
www.mockaroo.com

VBAのコード全体はこんな感じ

コード全体ですが、大変長くなりました。。

Sub generateProductSpecDescription()
'くり返し用変数
Dim i As Integer
Dim j As Integer

'生成するファイル名に関する変数
Dim htmlName As String
Dim siteName As String
Dim lastNum As Integer
Dim Target As String
Dim formatZero As String

'データ取得に関する変数
Dim first_name As String
Dim last_name As String
Dim avatar As String
Dim gender As String
Dim job As String
Dim sentences As String

'Streamオブジェクトを生成
Dim adoSt As Object
Set adoSt = CreateObject("ADODB.Stream")

'生成するファイル数
lastNum = Cells(Rows.Count, 1).End(xlUp).Row

siteName = "えむ家のメモ帳"

'プロフィールが存在する限りループ
For i = 2 To lastNum
    htmlName = "profile_"
    formatZero = returnZero(i - 1)
    Target = ActiveWorkbook.Path & "\" & htmlName & formatZero & ".html"
    first_name = Cells(i, 2).Value
    last_name = Cells(i, 3).Value
    avatar = Cells(i, 4).Value
    gender = Cells(i, 5).Value
    job = Cells(i, 6).Value
    sentences = Cells(i, 7).Value

    With adoSt
        'テキストデータ
        .Type = 2
        '文字コードをUTF-8に設定
        .Charset = "UTF-8"
        '改行コードを指定
        .LineSeparator = 10
        .Open
        'HTML開始
        .WriteText addHTML("", 0, "<!DOCTYPE html>"), 1
        .WriteText addHTML("", 0, "<html lang=""ja"">"), 1
        .WriteText addHTML("", 0, "<head>"), 1
        .WriteText addHTML("", 1, "<link rel="" stylesheet"" type="" text/css"" href=""../css/normalize.css"">"), 1
        .WriteText addHTML("", 1, "<link rel="" stylesheet"" type=""text/css"" href=""../css/common.css"">"), 1
        .WriteText addHTML("", 1, "<link rel="" stylesheet"" type=""text/css"" href=""../css/adjustment.css"">"), 1
        .WriteText addHTML("", 1, "<link rel="" stylesheet"" type=""text/css"" href=""./css/style.css"">"), 1
        .WriteText addHTML("", 1, "<meta id=""viewport""name=""viewport""content=""width=device-width,minimum-scale=1,maximum-scale=1""/>"), 1
        .WriteText addHTML("", 1, "<meta charset=""UTF-8"">"), 1
        .WriteText addHTML("", 1, "<title>VBAでExcelのデータを差し込んだHTMLを大量生産する-" & "プロフィール_" & formatZero & "|えむ家のメモ帳</title>"), 1
        .WriteText addHTML("", 0, "</head>"), 1
        .WriteText addHTML("", 0, "<body>"), 1
        .WriteText addHTML("", 1, "<header id=""header"">"), 1
        .WriteText addHTML("", 2, "<divclass=""logo""><a href=""//m-kenomemo.com"">えむ家のメモ帳</a></div>"), 1
        .WriteText addHTML("", 1, "</header>"), 1
        .WriteText addHTML("", 1, "<main class=""main"">"), 1
        .WriteText addHTML("", 2, "<h1>ExcelでHTMLを量産するサンプル</h1>"), 1
        .WriteText addHTML("", 2, "<p class=""mb40"">ExcelのVBAで同じテンプレートのHTMLファイルを大量生産しました。<br><a href=""https://m-kenomemo.com/excel-mass-item/"">解説記事を読む</a></p>"), 1
        .WriteText addHTML("", 2, "<p class=""center"">Profile_" & formatZero & "(" & i - 1 & "/" & lastNum - 1 & ")</p>"), 1
        .WriteText addHTML("", 2, "<section class=""profile_wrap"">"), 1
        .WriteText addHTML("", 3, "<h2>profile_main</h2>"), 1
        .WriteText addHTML("", 3, "<div class=""img_area"">"), 1
        .WriteText addHTML("", 4, "<img src=" & avatar & ">"), 1
        .WriteText addHTML("", 3, "</div>"), 1
        .WriteText addHTML("", 3, "<div class=""info_area"">"), 1
        .WriteText addHTML("", 4, "<table>"), 1
        .WriteText addHTML("", 5, "<tr>"), 1
        .WriteText addHTML("", 6, "<th>name</th>"), 1
        .WriteText addHTML("", 6, "<td>" & first_name & " " & last_name & "</td>"), 1
        .WriteText addHTML("", 5, "</tr>"), 1
        .WriteText addHTML("", 5, "<tr>"), 1
        .WriteText addHTML("", 6, "<th>job</th>"), 1
        .WriteText addHTML("", 6, "<td>" & job & "</td>"), 1
        .WriteText addHTML("", 5, "</tr>"), 1
        .WriteText addHTML("", 5, "<tr>"), 1
        .WriteText addHTML("", 6, "<th>gender</th>"), 1
        .WriteText addHTML("", 6, "<td>" & gender & "</td>"), 1
        .WriteText addHTML("", 5, "</tr>"), 1
        .WriteText addHTML("", 4, "</table>"), 1
        .WriteText addHTML("", 3, "</div>"), 1
        .WriteText addHTML("", 3, "<div class=""intro_area"">"), 1
        .WriteText addHTML("", 4, "<p>" & sentences & "</p>"), 1

        .WriteText addHTML("", 3, "</div>"), 1
        .WriteText addHTML("", 2, "</section><!--/profile_wrap-->"), 1

        .WriteText addHTML("", 2, "<div class=""nav"">"), 1
        .WriteText addHTML("", 3, "<span class=""nav_btn show-prev"">"), 1
        '最初のページの場合、ナビのPREVを表示しない
        If formatZero = 1 Then
            .WriteText addHTML("", 3, ""), 1
        Else
            .WriteText addHTML("", 4, "<a href=""./profile_" & returnZero(i - 2) & ".html""><img src=""./images/arrow_left.png""alt=""PREV"">PREV</a>"), 1
        End If

        .WriteText addHTML("", 3, "</span>"), 1
        .WriteText addHTML("", 3, "<span class=""nav_btn show-next"">"), 1
        '最後のページの場合、ナビのNEXTを表示しない
        If i = lastNum Then
            .WriteText addHTML("", 3, ""), 1
        Else
            .WriteText addHTML("", 4, "<a href=""./profile_" & returnZero(i) & ".html""><img src=""./images/arrow_right.png""alt=""NEXT"">NEXT</a>"), 1
        End If

        .WriteText addHTML("", 3, "</span>"), 1
        .WriteText addHTML("", 2, "</div>"), 1
        'プロフィール一覧
        .WriteText addHTML("", 2, "<section class=""list_wrap"">"), 1
        .WriteText addHTML("", 3, "<h2>profile_list</h2>"), 1
        .WriteText addHTML("", 3, "<ul class=""list"">"), 1

        'カレントユーザーの場合、リンクを無効にする
        For j = 2 To lastNum
            If formatZero = returnZero(j - 1) Then
                .WriteText addHTML("", 4, "<li>NO." & returnZero(j - 1) & "(" & Cells(j, 2).Value & " " & Cells(j, 3).Value & ")</li>"), 1
            Else
                .WriteText addHTML("", 4, "<li><a href=""./profile_" & returnZero(j - 1) & ".html"">NO." & returnZero(j - 1) & "(" & Cells(j, 2).Value & " " & Cells(j, 3).Value & ")</a></li>"), 1
            End If
        Next j

        .WriteText addHTML("", 3, "</ul>"), 1
        .WriteText addHTML("", 2, "</section><!-- /list_wrap -->"), 1

        .WriteText addHTML("", 1, "</main>"), 1
        .WriteText addHTML("", 1, "<footer id=""footer"">"), 1
        .WriteText addHTML("", 2, "<div class=""copyright"">Copyright 2020 &copy; m-kenomemo.com</div>"), 1
        .WriteText addHTML("", 1, "</footer>"), 1
        .WriteText addHTML("", 1, "</body>"), 1
        .WriteText addHTML("", 0, "</html>"), 1
        'HTMLここまで

        'BOMなしのUTF-8で出力する
        .Position = 0
        .Type = 1
        .Position = 3

        Dim byteData() As Byte
        byteData = .Read
        .Close

        .Open 'ストリームを開く
        .Write byteData 'ストリームに一時格納したデータを流し込む
        .SaveToFile Target, 2
        .Close
    End With
Next i
End Sub

'0埋めする関数
Function returnZero(ByVal num As Integer) As String
    If num < 10 ThenPolacode
        returnZero = "0" + CStr(num)
        Else
        returnZero = CStr(num)
    End If
End Function

'HTMLにタブを追加する関数
Function addHTML(ByVal strBase As String, ByVal cntIndent As Long, ByVal strAdd As String) As String
    If cntIndent > 0 Then
        Dim i As Long
        For i = 1 To cntIndent
            strBase = strBase & vbTab
        Next i
    End If
    
    strBase = strBase & strAdd & vbCr
    addHTML = strBase
End Function

生成するファイルの数を指定する

思ったより長いコードになったので、ポイントだけメモしておきます。

まずは、生成するHTMLファイルの数は、データを入力しているセルの最終行までとします。
セルA1の最終行の数を「lastNum」変数に格納します。

'生成するファイル数
lastNum = Cells(Rows.Count, 1).End(xlUp).Row

ADODB.Streamオブジェクトを設定する

VBAで生成されるファイルの文字コードは通常「Shift-JIS」になります。
HTMLファイルは「UTF-8」で作成することが多いので、今回は「UTF-8」でファイルを書き出します。

ADODB.Streamオブジェクト使用すると、ファイルの文字コードを指定できるようです。
オブジェクトを格納する変数を設定します。

'Streamオブジェクトを生成
Dim adoSt As Object
Set adoSt = CreateObject("ADODB.Stream")

参考サイト

エクセルVBAで文字コードUTF-8のCSVファイルを書き出す方法
エクセルのデータをファイルに書き出す方法シリーズです。今回は、エクセルVBAでADODB.Streamオブジェクトを使ってUTF-8の文字コードのCSVファイルを書き出す方法についてお伝えします。
tonari-it.com

プロフィールの数だけ処理を繰り返す

Forループでデータが入力されているセルの数だけ同じ処理を繰り返します。
変数iはセルデータの行を取得するのに使用します。
差し込むデータは2行目から開始となるので、Forループの処理も2から開始します。

ループの最初でHTMLファイルに差し込むデータを変数に格納します。

    'プロフィールが存在する限りループ
    For i = 2 To lastNum
        '変数セット
        htmlName = "profile_"
        formatZero = returnZero(i - 1)
        Target = ActiveWorkbook.Path & "\" & htmlName & formatZero & ".html"
        first_name = Cells(i, 2).Value
        last_name = Cells(i, 3).Value
        avatar = Cells(i, 4).Value
        gender = Cells(i, 5).Value
        job = Cells(i, 6).Value
        sentences = Cells(i, 7).Value
        
        'ここから繰り返す処理～
    Next i

HTMLファイルをBOMなしのUTF-8で出力する

先ほど作成したADODB.Streamオブジェクトを使って、HTMLファイルをUTF-8で書き出します。
HTMLファイルはBOMなしのUTF-8が標準なので、その設定に関するコードも追加します。

With adoSt
    'テキストデータ
    .Type = 2
    '文字コードをUTF-8に設定
    .Charset = "UTF-8"
    '改行コードを指定
    .LineSeparator = 10
    .Open

    'HTML開始～終了
    
    'BOMなしのUTF-8で出力する
    .Position = 0
    .Type = 1
    .Position = 3

    Dim byteData() As Byte
    byteData = .Read
    .Close

    .Open 'ストリームを開く
    .Write byteData 'ストリームに一時格納したデータを流し込む
    .SaveToFile Target, 2
    .Close
End With

参考サイト

エクセルVBAでBOM無しのUTF-8でCSVファイルなどを出力する方法
エクセルVBAでデータを様々なファイル形式に書き出す方法についてお伝えしています。今回は、エクセルVBAでBOMなしのUTF-8にてCSVファイルを書き出す方法についてお伝えしていきたいと思います。
tonari-it.com
VBScriptでUTF-8、改行コードLFのファイルを読み込む - Qiita
1. はじめに今回はVBSCriptで文字コードがUTF-8、改行コードがLFのテキストファイルを読み込む方法について説明したいと思います。ポイントはADODB.Streamを利用することです。…
qiita.com

HTMLのコードを追加していく

ここまで実装できたら、記述したいHTMLコードをどしどし追加していくだけです。
変数iを使えば、ページによっていろいろな条件分岐ができますね！
注意点はHTMLの「”」をエスケープする必要があることです。

あと、コードの見栄えをよくするために行の先頭にタブを追加しました。
これについては次のような関数を作成します。

'HTMLにタブを追加する関数
Function addHTML(ByVal strBase As String, ByVal cntIndent As Long, ByVal strAdd As String) As String
    If cntIndent > 0 Then
        Dim i As Long
        For i = 1 To cntIndent
            strBase = strBase & vbTab
        Next i
    End If
    
    strBase = strBase & strAdd & vbCr
    addHTML = strBase
End Function

参考サイト

エクセルVBAでインデントや改行を入れながらHTML文を追加していく便利関数を作る
エクセルVBAで自動でHTML生成シリーズです。今回はインデントや改行コードを入れながらHTML文を追加していく処理を関数化させつつ、Planセクションを生成するプログラムを作っていきます。
tonari-it.com
Excelの表の内容から自分好みのHTMLページを生成する [VBA] - 自動化.work
jidouka.work

まとめ

なんとか動作するVBAが作成できましたが、まだまだ内容を理解していないところが多いです。。
エクセルデータを差し込んでファイルを作成することは時々あるので、他にも応用できたらと思います！

スポンサーリンク

コメント