VBA使outlook和Word带谷歌翻译功能

最新推荐文章于 2023-07-05 10:43:35 发布

APP开发王

最新推荐文章于 2023-07-05 10:43:35 发布

阅读量433

点赞数

CC 4.0 BY-SA版权

文章标签： vba hex google blog 语言工具

本文链接：https://blog.youkuaiyun.com/wgsnet/article/details/3615427

本文介绍了一段VBA代码，用于通过Excel调用Google翻译API实现文本翻译功能。该代码能够将选中的文本进行URL编码，并发送HTTP请求获取翻译后的结果。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

VBA代码如下：

By wgscd

Date:2008/12/26

Blog:http://blog.youkuaiyun.com/wgsnet

Macro1()
   Dim transString As String
   Dim baseUrl As String
   Dim para As String
   Dim content As String
   baseUrl = "http://translate.google.com/translate_a/t?client=t&text="
   para = "&sl=en&tl=zh-CN"
  If Trim(Selection.Text) = "" Then
      Exit Sub
   End If
   
   content = URLEncode(Trim(Selection.Text))
   content = Replace(content, "%D", "%0D%0A")
   content = Replace(content, "%A1%B1", "%22")
   content = Replace(content, "%A1%B0", "%22")
   transString = GetHttpPage(baseUrl & content & para)
   transString = Replace(transString, "/r/n", vbNewLine)
   
   MsgBox transString
End Sub
Function GetHttpPage(HttpUrl)
   If IsNull(HttpUrl) = True Or HttpUrl = "$False$" Then
      GetHttpPage = "$False$"
      Exit Function
   End If
   Dim http
   Set http = CreateObject("MicroSoft.XMLHTTP")
   http.Open "GET", HttpUrl, False
   http.Send
  
   If http.ReadyState <> 4 Then
      Set http = Nothing
      GetHttpPage = "$False$"
      Exit Function
   End If
   
    If http.Status = 404 Then '找不到页面 
    
         'MsgBox "404" 
           GetHttpPage = "$False$"
        Exit Function
     End If
     
    
   GetHttpPage = BytesToBstr(http.responseBody, "utf-8")
   Set http = Nothing
   If Err.Number <> 0 Then
      Err.Clear
   End If
   
   
End Function
Function BytesToBstr(Body, Cset)
   Dim Objstream
   Set Objstream = CreateObject("adodb.stream")
   Objstream.Type = 1
   Objstream.Mode = 3
   Objstream.Open
   Objstream.Write Body
   Objstream.Position = 0
   Objstream.Type = 2
   Objstream.Charset = Cset
   BytesToBstr = Objstream.ReadText
   Objstream.Close
   Set Objstream = Nothing
End Function
Function GetBody(ConStr, StartStr, OverStr, IncluL, IncluR)
   If ConStr = "$False$" Or ConStr = "" Or IsNull(ConStr) = True Or StartStr = "" Or IsNull(StartStr) = True Or 
OverStr = "" Or IsNull(OverStr) = True Then
      GetBody = "$False$"
      Exit Function
   End If
   Dim ConStrTemp
   Dim Start, Over
   ConStrTemp = LCase(ConStr)
   StartStr = LCase(StartStr)
   OverStr = LCase(OverStr)
   Start = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
   If Start <= 0 Then
      GetBody = "$False$"
      Exit Function
   Else
      If IncluL = False Then
         Start = Start + LenB(StartStr)
      End If
   End If
   Over = InStrB(Start, ConStrTemp, OverStr, vbBinaryCompare)
   If Over <= 0 Or Over <= Start Then
      GetBody = "$False$"
      Exit Function
   Else
      If IncluR = True Then
         Over = Over + LenB(OverStr)
      End If
   End If
   GetBody = MidB(ConStr, Start, Over - Start)
End Function
Function ShowErr(ErrMsg)
response.Write "<script>alert('" & ErrMsg & "');history.back();</script>"
response.End
End Function
''--------url编码函数----------------- 
 Public Function URLEncode(ByRef strURL As String) As String
  Dim I     As Long
  Dim tempStr     As String
  For I = 1 To Len(strURL)
          If Asc(Mid(strURL, I, 1)) < 0 Then
                tempStr = "%" & Right(CStr(Hex(Asc(Mid(strURL, I, 1)))), 2)
                tempStr = "%" & Left(CStr(Hex(Asc(Mid(strURL, I, 1)))), Len(CStr(Hex(Asc(Mid(strURL, I, 1))))) - 2) & 
tempStr
                URLEncode = URLEncode & tempStr
          ElseIf (Asc(Mid(strURL, I, 1)) >= 65 And Asc(Mid(strURL, I, 1)) <= 90) Or (Asc(Mid(strURL, I, 1)) >= 97 And 
Asc(Mid(strURL, I, 1)) <= 122) Then
                URLEncode = URLEncode & Mid(strURL, I, 1)
          Else
                URLEncode = URLEncode & "%" & Hex(Asc(Mid(strURL, I, 1)))
          End If
  Next
  End Function
    
''---------URL反编码函数------------------- 
  Public Function URLDecode(ByRef strURL As String) As String
  Dim I     As Long
    
  If InStr(strURL, "%") = 0 Then URLDecode = strURL:                   Exit Function
    
  For I = 1 To Len(strURL)
          If Mid(strURL, I, 1) = "%" Then
                If Val("&H" & Mid(strURL, I + 1, 2)) > 127 Then
                      URLDecode = URLDecode & Chr(Val("&H" & Mid(strURL, I + 1, 2) & Mid(strURL, I + 4, 2)))
                      I = I + 5
                Else
                      URLDecode = URLDecode & Chr(Val("&H" & Mid(strURL, I + 1, 2)))
                      I = I + 2
                End If
          Else
                URLDecode = URLDecode & Mid(strURL, I, 1)
          End If
  Next
  End Function