无法使用VBA获取发布数据

时间:2014-12-11 04:51:32

标签: vba msxml

我正在尝试发布数据&以编程方式获取响应文本但似乎没有发布任何内容返回值,我得到默认网页中的相同HTML标记。我的代码是:

Sub GetData()
Dim htm As Object
Set htm = CreateObject("htmlFile")
With CreateObject("msxml2.xmlhttp")
   .Open "POST", "http://dreamsware.info/bahrio/loc/index.php", False
   .send "mcc=404&mnc=10&lac=246&cid=20001"
    htm.body.innerHTML = .responsetext
End With
Debug.Print htm.body.innerHTML
End Sub

提前致谢

1 个答案:

答案 0 :(得分:0)

这是您的代码(在消息框中)的结果。

---------------------------

---------------------------
<html>
<head>
<title>GSM LAC/CID -> location test</title>
</head>
<body>
<style type="text/css">
    body {
        font-family: Verdana, Helvetica, Geneva, Arial,
          SunSans-Regular, sans-serif;
        font-size:12;
    }
    td {
        font-family: Verdana, Helvetica, Geneva, Arial,
          SunSans-Regular, sans-serif;
        font-size:12;
    }
</style>
<center>
<table width="450">
<tr><td>
</td></tr>
</table>
<font size="1"><a href="http://bahrio.blogspot.com" target="_top">Bahri Okuroglu</a></font>
<form method="post" action="">
    <table>
        <tr>
            <td><a href="http://en.wikipedia.org/wiki/List_of_mobile_country_codes">MCC - Mobile Country Code</a></td>
            <td>
                <input type="text" size="5" name="mcc" value="286"><br />
            </td>
        <tr>
            <td><a href="http://en.wikipedia.org/wiki/Mobile_Network_Code">MNC - Mobile Network Code</a></td>
            <td>
                <input type="text" size="5" name="mnc" value="01"><br />
            </td>
        <tr>
            <td>LAC - Location Area Code</td>
            <td>
                <input type="text" size="5" name="lac" value="21534"><br />
            </td>

---------------------------
OK   
---------------------------

但你犯了一个错误,就是不测试会发生什么。

网址必须100%正确。与浏览器不同,没有代码可以修复网址。

我的程序的目的是获取错误详细信息。

我如何获得正确的网址是在浏览器中输入我的网址,导航,并且正确的网址通常位于地址栏中。另一种方法是使用链接等的属性来获取URL。

Microsoft.XMLHTTP也映射到Microsoft.XMLHTTP.1.0。 HKEY_CLASSES_ROOT \ Msxml2.XMLHTTP映射到Msxml2.XMLHTTP.3.0。再试一次

使用xmlhttp尝试这种方式。编辑网址等。如果它似乎工作注释if / end if转储信息,即使看起来工作。它是vbscript但vbscript在vb6中工作。

 On Error Resume Next
 Set File = WScript.CreateObject("Microsoft.XMLHTTP")
 File.Open "GET", "http://www.microsoft.com/en-au/default.aspx", False
 'This is IE 8 headers
 File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
 File.Send
 If err.number <> 0 then 
    line =""
    Line  = Line &  vbcrlf & "" 
    Line  = Line &  vbcrlf & "Error getting file" 
    Line  = Line &  vbcrlf & "==================" 
    Line  = Line &  vbcrlf & "" 
    Line  = Line &  vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description 
    Line  = Line &  vbcrlf & "Source " & err.source 
    Line  = Line &  vbcrlf & "" 
    Line  = Line &  vbcrlf & "HTTP Error " & File.Status & " " & File.StatusText
    Line  = Line &  vbcrlf &  File.getAllResponseHeaders
    wscript.echo Line
    Err.clear
    wscript.quit
 End If

On Error Goto 0

 Set BS = CreateObject("ADODB.Stream")
 BS.type = 1
 BS.open
 BS.Write File.ResponseBody
 BS.SaveToFile "c:\users\test.txt", 2

同时查看这些其他对象是否有效。

C:\Users>reg query hkcr /f xmlhttp

HKEY_CLASSES_ROOT\Microsoft.XMLHTTP
HKEY_CLASSES_ROOT\Microsoft.XMLHTTP.1.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.3.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.4.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.5.0
HKEY_CLASSES_ROOT\Msxml2.ServerXMLHTTP.6.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.3.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.4.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.5.0
HKEY_CLASSES_ROOT\Msxml2.XMLHTTP.6.0
End of search: 12 match(es) found.

另请注意,在发生锁定之前,您可以调用任何特定XMLHTTP对象的次数有限制。如果发生这种情况,并且在调试代码时会发生这种情况,只需更改为

即可