none
【Windows10】VBAでのPOST送信の不具合 RRS feed

  • 質問

  • Access VBAで、サーバ側にxmlをPOST送信する処理があるのですが、Window10PCでを動かした場合に、
    パラメータがうまく送られず、サーバ側で受け取ったときに空文字になっています。

    エラーメッセージは特に出ていません。

    Windows7のPCでは、パラメータは問題なく送れていました。

    上記問題を解消するには、どのようにすればいいでしょうか?

    以下、ソースコードです。(ChangeChr(postXML)が、サーバ側で空文字になっています)

    Public Function HttpPOST(strURL As String, postXML As String) As String
    
    Dim objHttp As Object
    Dim objDoc As Object
    Dim resXML As String
    Dim strErrMsg As String
    
    On Error GoTo HttpPOST_Err
    
    HttpPOST = vbNullString
    
        Set objHttp = CreateObject("MSXML2.ServerXMLHTTP")
    
        With objHttp
            'タイムアウトの設定
            .setTimeouts 30000, 30000, 30000, 30000
            '定型句
            .Open "POST", strURL, False
            .SetRequestHeader "Content-Type", "application/xml; charset=""Shift_JIS"""
            'Shift-JISにしてPOST
            .send (ChangeChr(postXML))
    
            '接続NGの場合Exit
            If .Status <> 200 Then GoTo HttpPOST_Err
    
            '取得内容をユニコードに変換
            resXML = StrConv(.responseBody, vbUnicode)
    Debug.Print resXML
            HttpPOST = resXML
    
        End With
        Set objHttp = Nothing
    
    Exit Function
    
    〜〜途中のソースは省略〜〜
    
    Public Function ChangeChr(strXML As String) As Byte()
    Dim objSTREAM As Object
    On Error Resume Next
        Set objSTREAM = CreateObject("ADODB.Stream")
        With objSTREAM
            .Open
            .Type = adTypeText
            .Charset = "Shift_JIS"
            .WriteText strXML
            .Position = 0
            .Type = adTypeBinary
            .Position = 0
            ChangeChr = .Read()
        End With
    
        objSTREAM.Close:    Set objSTREAM = Nothing
    End Function

    ・試したこと、確認したこと

    送信しているパラメータ(ChangeChr(postXML))には、
    問題なく値が設定されていることは確認できています。
    また、java側ではパラメータ空文字になってしまっていますが、
    受信自体は出来ています。

    また、以下を試しています。

    ・CreateObject("MSXML2.ServerXMLHTTP")の修正
     CreateObject("MSXML2.ServerXMLHTTP.3.0")や、
     CreateObject("MSXML2.ServerXMLHTTP.6.0")に
     変更して動かしてみましたが、改善しませんでした。

    ・SetRequestHeaderの修正
     "Content-Type", "application/xml; charset=""utf-8"""や、
     "Content-Type", "application/x-www-form-urlencoded; charset=""Shift_JIS"""に
     変更して動かしてみましたが、改善しませんでした。 

    • 編集済み morimo02 2016年4月25日 8:10
    2016年4月25日 3:32

すべての返信

  • 参照設定はどうなっていますでしょうか?

    私の環境(Windows 10 64bit & Access 2016 32bit )で動かしてみたところ、「.send (ChangeChr(postXML))」の行で実行時エラーとなりましたので、

    参照設定で「Microsoft ActiveX Data Objects 6.1 Library」を追加したところ、正常に動きました。サーバー側でXMLが渡ってきているのを確認。

    2016年4月25日 11:37
  • 返信ありがとうございます。

    「Microsoft ActiveX Data Objects 6.1 Library」は、元からチェックが入っておりました。

    チェックを外してみたところ、たしかに上記のエラーが出たのですが、

    再度チェックを入れると、元の状態に戻ってしまいます。

    2016年4月25日 12:35
  • すみません。ちょっと原因がわからないですね。

    こちらでさらにネットワーク環境の違う 2 つの Win10 で試してみましたが正常に動きました。試した Access ファイルは http://work.vc/Database1.zip にアップロードしています。データを受け取るサーバー側のプログラム(http://work.vc/test.php)は下記のようになっています。

    <?php 
    var_dump($_POST,file_get_contents('php://input'));
    ?>

    検証に使ったXMLは「<item>hello</item>」と単純なものです。XML をこのように単純にしても再現しますでしょうか?また、Microsoft Network Monitor などを使って正しくデータがサーバーに送信されているか確認してみてはいかがでしょうか?データが正しく送信されている場合、受け取り側に問題があるかもしれません。

    2016年4月26日 1:30
  • 返信ありがとうございます。

    送っているデータを、"abc"などの単純な文字列にしても同様のことが起こります。

    WireSharkを使い、やはりPCから送信するときにデータが欠落しているように見えるのですが、

    必要であればMicrosoft Network Monitorも使ってみます。

    2016年4月26日 4:10
  • WireShark で確認されているのでしたら、おそらく Microsoft Network Monitor でも同様の結果だと思います。

    こちらでは正しく動いているため具体的な回答を出せなくて申し訳ないです。

    morimo02 様のほうで一つずつ問題となる可能性を単純化・細分化してつぶしていくしかないと思います。
    原因は下記のどれかか複合的な組み合わせだと思います。

    1. VBAのプログラムに問題がある
    →単純なコードを実行して動くか
    Sub test()
        Dim httpReq As Object
        Set httpReq = CreateObject("MSXML2.ServerXMLHTTP")
        Call httpReq.Open("POST", "http://work.vc/test.php", False)
        Dim postData As Variant
        postData = "<item>hello</item>"
        Call httpReq.Send(postData)
        If httpReq.Status = 200 Then
            Debug.Print httpReq.responseText
        End If
        Set httpReq = Nothing
    End Sub


    2. VBAの実行環境に問題がある
    → 例えば Excel VBA で動くか試してみる。
    → VBScriptで動くか試してみる。
    Option Explicit
    
    Dim httpReq
    Set httpReq = WScript.CreateObject("MSXML2.ServerXMLHTTP")
    httpReq.open "POST", "http://work.vc/test.php", False
    httpReq.send "<item>hello</item>"
    If httpReq.Status = 200 Then
    	MsgBox httpReq.responseText
    End If
    Set httpReq = Nothing


    3. 通信環境に問題がある(OSの設定(プロキシなど)や常駐ソフトによって通信が遮断されているなど)
    →設定や環境の異なるWindows 10マシンで動くか試してみる。動く場合は、設定の違いを比較する。

    4. サーバー側に問題がある
    →受信したデータをすべて表示して、該当のデータが受信できているか。
    2016年4月26日 5:40