怎么把百度地图的搜索结果全部导出到Excel文件

604825714

suwenkai 发表于 2014-10-4 20:13

搜索项如何修改，比如搜索餐饮改为其他的

butter15

貌似失效了!!!

BERYLE01

VBA万岁 发表于 2015-4-11 15:12
附件：

那个窗体版只能搜索餐饮的，不能自定义吗

rtian

既然是百度地图数据，为啥不直接使用百度地图API呢？有空测试一下

runda

VBA万岁 发表于 2015-5-28 16:05
只要对VBA有兴趣，相信你一定会“什么都会”的。

请问   VBA万岁：

附件下载后试用时发现启用IE出现问题，如下：
•确保 Web 地址 http://  正确。
•使用搜索引擎查找页面。
•请过几分钟后刷新页面。
这是什么原因呢？其中KTV那个可以用，正常抓取到。但是其他的不可以，估计问题出现在IE这块（所用IE版本：11.306.10586.0）。请帮忙解答下，谢谢！

wpppl

这个有没有更新版啊 有时候查询没有结果啊

348568984

Sub 百度地图搜索()
    Dim objson As Object, StrJs As String, url As String, p
    Cells.Clear
    [a1:c1] = [{"店名","地址","电话"}]
    Set objson = CreateObject("scriptcontrol")
    objson.Language = "javascript"
        For p = 1 To 1000
        url = "http://map.baidu.com/?newmap=1"
        url = url & "&reqflag=pcmap"
        url = url & "&biz=1"
        url = url & "&pcevaname=pc2"
        url = url & "&da_par=direct"
        url = url & "&from=webmap"
        url = url & "&qt=s"
        url = url & "&from=webmap"
        url = url & "&c=119"
        url = url & "&wd=ktv"
        url = url & "&pn=" & p - 1
        url = url & "&db=0"
        url = url & "&sug=0"
        url = url & "&da_src=pcmappg.poi.page"
        url = url & "&on_gel=1"
        url = url & "&src=7"
        url = url & "&gr=3"
        url = url & "&l=13"
        url = url & "&addr=0"
        url = url & "&nn=" & (p - 1) * 10
        url = url & "&ie=utf-8"
        url = url & "&t=1428490938134"
        With CreateObject("msxml2.xmlhttp")
            .Open "GET", url, False
            .send
         StrJs = "var a=" & .responsetext & ";var s=''; for(x in a.content){ s+=a.content[x].name+'\t'+a.content[x].addr+'\t'+a.content[x].tel+'\r';};"
            StrJs = objson.Eval(StrJs)
        End With
        With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
            .SetText StrJs
            .PutInClipboard
        End With
        With ActiveSheet
            .Cells(Rows.Count, 1).End(xlUp).Offset(1).Select
            .Paste
        End With
    Next p
End Sub

Private Sub TextBox1_Change()

End Sub


哪位大神帮忙看看，我想搜索整个东莞的KTV，搜出来只有552个，而在百度上搜索应该是815个。是不是哪里设置错了，导致有些没有搜索到？？

xiangyuwxl

suwenkai 发表于 2014-10-4 20:13

suwenkai,现在这个代码貌似不能用了，是不是百度改新版了？

xiangyuwxl

谢谢suwenkai老师的分享

jikea

QQ:2198278875