Step 2　検索文字列をUTF-8へ変換テスト

Yahoo・Googleの検索順位チェックソフトを作ってみよう

Step 2　検索文字列をUTF-8へ変換テスト

例えば「エクセル　VBA」をヤフーで検索するとURLは
http://search.yahoo.co.jp/search?p=%E3%82%A8%E3%82%AF%E3%82%BB%E3%83%AB%E3%80%80VBA&search.x=1&fr=top_ga1&tid=top_ga1&ei=UTF-8
になります。最後にUTF-8とあります。
この%の部分がUTF-8へエンコードした文字列になります。

この%の文字が作成できれば、URLが作成できることになります。

シート画面

とりあえずテストで「エクセル　VBA」をエンコードします。
D6にキーワードを入力し、「チェック開始」ボタンをクリックします。
キーワードでヤフーとグーグル検索

テストコード

下記のコードを入力してください。

Option Explicit

Private Sub CommandButton1_Click()
    Dim s1 As String
    Dim s2 As String

    s1 = Cells(6, 4)
    s2 = ExEncodeToUTF8(s1)
    Debug.Print s2
End Sub

Option Explicit

Private Declare Function WideCharToMultiByte Lib "kernel32" _
        (ByVal CodePage As Long, _
        ByVal dwFlags As Long, _
        lpWideCharStr As Integer, _
        ByVal cchWideChar As Long, _
        lpMultiByteStr As Byte, _
        ByVal cchMultiByte As Long, _
        ByVal lpDefaultChar As String, _
        ByVal lpUsedDefaultChar As Long) As Long

Private Const CP_UTF8 = 65001

Public Function ExEncodeToUTF8(sSrc As String) As String
    Dim i As Integer
    Dim lLen As Long
    Dim s1 As String
    Dim sUniBuf() As Integer
    Dim sRet As String
    Dim lSize As Long
    Dim btUtf8Buf() As Byte

    ExEncodeToUTF8 = ""
    lLen = Len(sSrc)
    If lLen = 0 Then
        Exit Function
    End If

    ReDim sUniBuf(0 To lLen - 1)
    For i = 0 To lLen - 1 Step 1
        sUniBuf(i) = AscW(Mid(sSrc, i + 1, 1))
    Next

    ReDim btUtf8Buf(lLen * 3)
    'UTF8変換
    lSize = WideCharToMultiByte(CP_UTF8, 0, sUniBuf(0), lLen, btUtf8Buf(LBound(btUtf8Buf)), lLen * 3, vbNullString, 0)
    If lSize = 0 Then Exit Function

    sRet = ""
    For i = 0 To lSize - 1
        s1 = Hex(btUtf8Buf(i))
        sRet = sRet & "%" & s1
    Next
    Debug.Print sRet
    ExEncodeToUTF8 = sRet

End Function

これを実行すると
「%E3%82%A8%E3%82%AF%E3%82%BB%E3%83%AB%E3%80%80%56%42%41」が返ります。
これでうまく行きそうです。

Topへ