エクセルでA1に入っている文字列をUTF-8に変換、URLエンコードをして、ファイルに書き出すというマクロ?VBA?はどう書きますか?


また、その中に簡単なコメントも入れてほしいです。

さらに、そのマクロ?VBA?はどこにどうかいてどう実行すればいいのかまで教えてください。

回答の条件
  • 1人2回まで
  • 登録:2009/04/14 15:15:55
  • 終了:2009/04/21 15:20:03

回答(1件)

id:SALINGER No.1

SALINGER回答回数3430ベストアンサー獲得回数9692009/04/15 10:26:23

ポイント10pt

まずVBAの説明から。

自分で作ったマクロはVBEの標準モジュールというところに書き込みます。以下を参考にしてみてください。

http://www.officepro.jp/excelvba/ini/index1.html

http://www.officepro.jp/excelvba/ini/index2.html

http://www.officepro.jp/excelvba/ini/index3.html


コードではADODB.Streamを使いUTF-8に変換し、

http://www.geocities.co.jp/SilkRoad/4511/vb/urlenc.htm

のUrlEncode関数を使いURLエンコードをしています。


以下の2つのコードを標準モジュールにコピペして、コードの先頭の方にあるファイルのパスを指定して、

メニューから実行→sub/ユーザーフォームの実行

を選べば、指定した位置にテキストファイルを作成します。


Option Explicit
 
Private Sub Con_Charset()
    '書き出すテキストファイルのパスに書き換えてください。
    Const Filename = "C:\Documents and Settings\hogehoge\デスクトップ\test.txt"
    Dim shiftjObj As Object
    Dim utf8Obj As Object
    Dim str As String
    
    'Shift-JISのADODB.Streamを作成してA1セルを読み込みます
    Set shiftjObj = CreateObject("ADODB.Stream")
    With shiftjObj
        .Type = 2
        .Charset = "shift-jis"
        .Open
        .WriteText() = ActiveSheet.Range("A1")
        .Position = 0
    End With
    
    'Utf-8のADODB.Streamを作成します
    Set utf8Obj = CreateObject("ADODB.Stream")
    With utf8Obj
        .Type = 2
        .Charset = "utf-8"
        .Open
    End With

    'Shift-JISのADODB.StreamをUtf-8のADODB.Streamをコピーします
    shiftjObj.CopyTo utf8Obj
    utf8Obj.Position = 0
    
    'Urlエンコードします
    str = UrlEncode(utf8Obj.ReadText())
    utf8Obj.Position = 0
    utf8Obj.WriteText() = str
    
    'Utf-8のADODB.Streamを保存します(2は上書き)
    utf8Obj.Savetofile Filename, 2
End Sub

以下は、VBの関数ですがそのまま使えそうなのでリンク先と一緒です。

Public Function UrlEncode(ByRef strSource As String) As String

 Dim lngLength As Long                                          '文字列のサイズ(S-JIS 変換後)を格納する
 Dim bytSource() As Byte                                        'ANSI/S-JIS に変換した文字列を格納するバイト型配列
 Dim strBuffer As String                                        'URL エンコードされた文字列を一時格納するバッファ
 Dim bytSingle As Byte                                          '配列から抜き出した 1 バイトを格納する
 Dim strSingleHex As String                                     '文字コードを 16 進化した文字列を格納する
 Dim lngReadCount As Long                                       'bytSource 読み込み位置カウンタ
 Dim lngWriteCount As Long                                      'strBuffer 書き込み位置カウンタ
 
    lngLength = LenB(StrConv(strSource, vbFromUnicode))         'ANSI/S-JIS 変換後のサイズを求める
    If Not CBool(lngLength) Then Exit Function                  '0 バイトの場合関数を抜ける
    ReDim bytSource(lngLength - 1)                              'ANSI/S-JIS 変換文字列を格納する領域を確保
    bytSource = StrConv(strSource, vbFromUnicode)               'ANSI/S-JIS に変換し bytSource に格納
    
    strBuffer = String$(lngLength * 3, vbNullChar)              'URL エンコード文字列一時格納バッファを確保
    strSingleHex = "%00"                                        '16 進化した文字コードを格納するバッファを確保
    lngWriteCount = 1                                           '書き込みカウンタは 1 から開始
    
    Do                                                          '文字列の終端までループ
        bytSingle = bytSource(lngReadCount)                     '配列から 1 バイト抜く(毎回参照するより速い?)
        If ((bytSingle >= &H81) And (bytSingle <= &H9F)) Or _
           ((bytSingle >= &HE0) And (bytSingle <= &HEF)) Then   'Shift-JIS 2 バイト文字と確認された場合
            Mid(strSingleHex, 2, 2) = Hex$(bytSingle)           '文字コードを 16 進数に変換(上位バイト)
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
            If lngReadCount = lngLength Then Exit Do            '文字列の終端に達した場合、ループを抜ける
            bytSingle = bytSource(lngReadCount)                 '配列から 1 バイト抜く
            Mid(strSingleHex, 2, 2) = Hex$(bytSingle)           '文字コードを 16 進数に変換(下位バイト)
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
        ElseIf bytSingle = &H20 Then                            '半角スペース文字(" ")の場合
            Mid(strBuffer, lngWriteCount, 1) = "+"              '"+" を代わりに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 1                   '書き込みカウンタを 1 増やす
        ElseIf ((bytSingle >= &H40) And (bytSingle <= &H5A)) Or _
               ((bytSingle >= &H61) And (bytSingle <= &H7A)) Or _
               ((bytSingle >= &H30) And (bytSingle <= &H39)) Or _
               (bytSingle = &H2A) Or _
               (bytSingle = &H2D) Or _
               (bytSingle = &H2E) Or _
               (bytSingle = &H5F) Then                          '無変換文字であった場合
            Mid(strBuffer, lngWriteCount, 1) = Chr$(bytSingle)  '文字コードを文字列に戻して書き込む(^^;
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 1                   '書き込みカウンタを 1 増やす
        Else                                                    'その他の文字の場合
            If bytSingle <= &HF Then                            'Hex$() の結果が 1 文字になる場合
                Mid(strSingleHex, 2, 1) = "0"                   '0 を先頭に付加
                Mid(strSingleHex, 3, 1) = Hex$(bytSingle)       '文字コードを 16 進数に変換
            Else                                                '0 を付加する必要がない場合
                Mid(strSingleHex, 2, 2) = Hex$(bytSingle)       '文字コードを 16 進数に変換
            End If
            Mid(strBuffer, lngWriteCount, 3) = strSingleHex     'URL エンコードされた文字列をバッファに書き込む
            lngReadCount = lngReadCount + 1                     '読み込みカウンタをインクリメント
            lngWriteCount = lngWriteCount + 3                   '書き込みカウンタを 3 増やす
        End If
    Loop Until lngReadCount = lngLength

    Erase bytSource                                             'バイト型配列を消去
    
    If lngWriteCount > 1 Then                                   'バッファに文字列が書き込まれた場合
        UrlEncode = Left$(strBuffer, lngWriteCount - 1)         'バッファの余分な部分を削り、戻り値とする
    End If

End Function
  • id:SALINGER
    回答で間違いがありました。
    URLエンコードの部分なのですが、Shift-JISからのURLエンコードとしてしまいました。

    Utf-8からのURLエンコードなのでこちらのUrlEncodeUtf8関数を使ってください。
    http://www.geocities.co.jp/SilkRoad/4511/vb/sample/ue_utf8.txt

    具体的には、2つ目のコードを上記のUrlEncodeUtf8のコードにして、
    1つ目のコード中で一箇所UrlEncodeの部分をUrlEncodeUtf8としてください。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません