ホーム / vba /

VBAでPOSTでリクエストを送って、戻り値の文字コードを変換してみた

2012年5月24日木曜日

tips vba

t f B! P L
VBAでPOSTデータを送ること自体はとてもたくさんサンプルがありますが、戻り値の文字コードを変換する部分があまりなかったので作成してみました。 ファイルの入出力が面倒だったので、行なっていません。 
Sub sample()
    Dim mText As String, mParam As String
    mParam = "hoge=hogehoge&moge=mogemoge"

    ' 戻り値の文字コードがUTF-8の場合
    mText = convTextEncoding(HttpRequest(mUrl, "POST", mParam), "UTF-8")
End Sub

'
' 概要
'   url に param を付与し、指定の method でリクエストを行い responseBody を返す関数
' 引数
'   url : urlのリクエスト先URL
'   method : "GET" or "POST"
'   param : 付与するパラメータ
' 戻り値
'   responseBody : utf-8
'
Private Function myHttpRequest(ByVal url As String, ByVal method As String, ByVal param As String)
    Dim mUrl As String
    Dim mParam As String
    
    If method = "POST" Then
        mUrl = url
        mParam = param
    ElseIf method = "GET" Then
        mUrl = url & "?" & param
        mParam = ""
    End If
    
    Dim xmlhttp As Object
    Set xmlhttp = CreateObject("msxml2.xmlhttp")
    
    xmlhttp.Open method, mUrl, False
    
    If param <> "" Then
        xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        
        Dim bPmary() As Byte
        bPmary = StrConv(param, vbFromUnicode)
    
        xmlhttp.send (bPmary)
    Else
        xmlhttp.send
    End If
    
    Dim mCode As String
    mCode = xmlhttp.Status
    If mCode <> 200 Then
        myHttpRequest = "response:" & mCode
    Else
        myHttpRequest = xmlhttp.responsebody
    End If

    Exit Function
    
End Function



'
' 概要
'   引数で渡された text の文字コードを変換する関数
' 引数
'   text : 変換前の文字列
'   fromCharaset : 変換前の文字コード
'   toCharaset : 変換後の文字コード(default : unicode)
' 戻り値
'   変換後の文字列
'
Private Function convTextEncoding(ByVal text, ByVal fromCharaset As String, Optional ByVal toCharaset As String = "unicode")
    Dim convText As String
    With CreateObject("ADODB.Stream")
        .Open
        .Type = adTypeText
        .Charset = toCharaset
        .WriteText text

        .Position = 0
        .Type = adTypeText
        .Charset = fromCharaset
On Error GoTo myLabel
        convText = .ReadText()
        convTextEncoding = Mid(convText, 3, Len(convText))
On Error GoTo 0
    End With
    
    Exit Function
    
myLabel:
    convTextEncoding = StrConv(text, vbUnicode, 1041)

End Function
私の場合はPOSTのパラメータにLFで改行された文字列を渡していました。 mParam = "ABCDE" & vbLf & "DEFGH" 別にPOSTで渡す値は必ずしも"&"で区切られている必要もないし、"="で結ばれている必要もありません。 って、このあたりはリクエストを受け取る側の話とか、もっと低階層の話しなので割愛。 正直私もあんまり詳しくありません。

QooQ