Step27：変換元と先ファイル両方にURLを挿入できるように変更する｜Excel VBA

変換元と変換後のAMPファイルは、お互いにをcanonicalでURLを指定する必要があります。これまでAMPファイルのみ行っていたので、元ファイルもできるように修正します。

方法はUTF-8ファイル保存とcanonicalを追加するVBAの引数に、ファイルを読み込んだ変数を追加するだけです。

UTF-8ファイル保存のVBA

ExUtfSaveプロシージャの変更
UTF-8ファイル保存のVBA

・引数にsbufを追加し、変換元と変換先の両方で保存できるようにしています。

Private Sub ExUtfSave(sbuf As String, fname As String)
    Dim tobj As Object
    Dim i As Long
    Dim byteTmp() As Byte

    Set tobj = CreateObject("ADODB.Stream")
    tobj.Charset = "UTF-8"
    tobj.Open
    tobj.Writetext sbuf
    tobj.Position = 0
    tobj.Type = 1
    tobj.Position = 3
    byteTmp = tobj.Read
    tobj.Close

    Set tobj = CreateObject("ADODB.Stream")
    tobj.Charset = "UTF-8"
    tobj.LineSeparator = 10
    tobj.Type = 1
    tobj.Open
    tobj.Write byteTmp
    tobj.SetEOS
    tobj.SaveToFile fname, 2
    tobj.Close
End Sub

canonicalを追加するVBA

ExUtfSaveプロシージャの変更
canonicalを追加するVBA

・上と同じく引数にsbufを追加し、変換元と変換先の両方でcanonicalを追加できるようにしています。

Private Sub MyAddUrl(sbuf As String, surl As String)
    Dim ln1 As Long
    Dim s1 As String
    Dim s2 As String
    Dim s3 As String
    Dim lc As Long

    ln1 = InStr(1, sbuf, "<head>", vbTextCompare)
    If Mid(sbuf, ln1 + 6, 1) <> vbCr Then
        s1 = Left(sbuf, ln1 + 5) & vbCr
        s2 = Right(sbuf, Len(sbuf) - ln1 - 5)
    Else
        s1 = Left(sbuf, ln1 + 6)
        s2 = Right(sbuf, Len(sbuf) - ln1 - 6)
    End If

    surl = Replace(surl, "\", "/", , , vbTextCompare)

    s3 = "<link rel=""canonical"" href=""" & surl & """>"
    sbuf = s1 & s3 & vbCr & s2

    Debug.Print Left(sbuf, 1000)
End Sub

変換元のHTMLファイルです。
ampフォルダが追加されたURLが挿入されています。

作成したAMPファイルです。
元ファイルのURLが挿入されています。

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します