网抓，有道翻译

学不完用不尽

要求：
利用“有道翻译”，对文本进行互译。
即：将工作表中的A列内容，复制到“有道翻译”的“原文/网址”文本框中，自动翻译，将翻译结果文本框中的结果输入到对应的B列单元格中。
有道翻译网址：http://fanyi.youdao.com


有道翻译.rar (9.94 KB, 下载次数: 39)

2015-3-29 15:37 上传

点击文件名下载附件

补充内容 (2018-1-5 20:02):
完美解决见18楼

补充内容 (2018-1-5 23:23):
简化版见19楼

学不完用不尽

会网抓的老师们，请帮帮忙，在此谢过！

suwenkai

Sub 按钮1_Click()
    Dim pd As String
    Dim html As Object

    Set js = CreateObject("scriptcontrol")
    js.Language = "jscript"

    For i = 2 To 5
        pd = "type=AUTO"
        pd = pd & "&i=" & Cells(i, 1).Value    '这里缺少一个中文转码的函数，一时找不到所以用不了中文转英文，只能英文转中文
        pd = pd & "&doctype=json"


        Set html = CreateObject("htmlfile")
        URL = "http://fanyi.youdao.com/translate?smartresult=dict&smartresult=rule&smartresult=ugc&sessionFrom=null"
        With CreateObject("msxml2.xmlhttp")
            .Open "POST", URL, False
            .setrequestHeader "Host", "fanyi.youdao.com"
            .setrequestHeader "Connection", "keep-alive"
            .setrequestHeader "Content-Length", "137"
            .setrequestHeader "Accept", "application/json, text/javascript, */*; q=0.01"
            .setrequestHeader "Origin", "http://fanyi.youdao.com"
            .setrequestHeader "X-Requested-With", "XMLHttpRequest"
            .setrequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/41.0.2272.101 Safari/537.36"
            .setrequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .setrequestHeader "Referer", "http://fanyi.youdao.com/"
            .setrequestHeader "Accept-Encoding", "gzip, deflate"
            .setrequestHeader "Accept-Language", "zh-CN,zh;q=0.8"
            .send (pd)
            js.addcode "suwenkai=" & .responsetext

            Cells(i, 2) = js.eval("suwenkai.translateResult[0][0].tgt")


        End With
    Next
End Sub

缔造者

suwenkai 发表于 2015-3-29 22:23
Sub 按钮1_Click()
    Dim pd As String
    Dim html As Object

suwenkai老师您好！对您的帮助表示感谢！
经测试，发现部分翻译语句逻辑关系错误或结果错误。


利用“有道翻译”的结果：



附件：
有道翻译.rar (13.57 KB, 下载次数: 59)

2015-3-30 10:05 上传

点击文件名下载附件

学不完用不尽

suwenkai 发表于 2015-3-29 22:23
Sub 按钮1_Click()
    Dim pd As String
    Dim html As Object

谢谢suwenkai老师！
像4楼的情况怎样修改？

suwenkai

看图片中的问题。你打的时候不要中文字符。

suwenkai

修改一下你的字符，结果就正常了。

学不完用不尽

suwenkai 发表于 2015-3-30 22:07
修改一下你的字符，结果就正常了。

换成英文撇号也可以。
再次谢谢您！！

浮华、缠绕指尖

本来给了你函数又不要，唉，怪谁呢。

学不完用不尽

浮华、缠绕指尖 发表于 2015-3-30 23:25
本来给了你函数又不要，唉，怪谁呢。

老师，您说的函数在哪呢？能否传个附件？谢谢您关注！！