Valori delle celle di Excel con lettere speciali non riconosciuti quando inviati a Ricerca Google tramite VBA

Aug 23 2020

Ho un file Excel con celle contenenti parole scritte con caratteri speciali (é, î, ù, ecc.) che ho inviato alla ricerca di Google. Uso VBA per questo e sembra che VBA li riconosca senza alcun problema quando si utilizza MsgBox. Ma quando quelle parole appaiono nella barra di ricerca di Google, le lettere accentate si trasformano in punti interrogativi (es.: île diventa ?le ).

(Le mie impostazioni regionali sono già visualizzate per poter leggere quelle lettere speciali.)

Ecco il mio codice VBA:

Sub SpecialLetters()
Dim objIe As Object

Set objIe = CreateObject("InternetExplorer.Application")
objIe.Visible = True

objIe.navigate "http://www.google.com/search?hl=en&ie=UTF-8&q=" & Sheets("Sheet1").Range("A1").Value
    
End Sub

Risposte

4 DecimalTurn Aug 23 2020 at 15:19

Per evitare ciò, puoi codificare il termine di ricerca nel modo URL standard.

Se hai Excel 2013 o versioni successive, puoi utilizzare WorksheetFunction.EncodeURL per farlo. Il tuo codice sarebbe quindi:

Sub SpecialLetters()
Dim objIe As Object

Set objIe = CreateObject("InternetExplorer.Application")
objIe.Visible = True

objIe.Navigate "http://www.google.com/search?hl=en&ie=UTF-8&q=" & WorksheetFunction.EncodeURL(Sheets("Sheet1").Range("A1").Value)
    
End Sub

Per Excel 2010 o versioni precedenti, non c'era modo di farlo senza creare la tua funzione, ma fortunatamente Tomalak ha già fornito una funzione per farlo in VBA ( vedi qui ), puoi semplicemente usare questo:

Public Function URLEncode( _
   ByVal StringVal As String, _
   Optional SpaceAsPlus As Boolean = False _
) As String
  Dim bytes() As Byte, b As Byte, i As Integer, space As String

  If SpaceAsPlus Then space = "+" Else space = "%20"

  If Len(StringVal) > 0 Then
    With New ADODB.Stream
      .Mode = adModeReadWrite
      .Type = adTypeText
      .Charset = "UTF-8"
      .Open
      .WriteText StringVal
      .Position = 0
      .Type = adTypeBinary
      .Position = 3 ' skip BOM
      bytes = .Read
    End With

    ReDim result(UBound(bytes)) As String

    For i = UBound(bytes) To 0 Step -1
      b = bytes(i)
      Select Case b
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Chr(b)
        Case 32
          result(i) = space
        Case 0 To 15
          result(i) = "%0" & Hex(b)
        Case Else
          result(i) = "%" & Hex(b)
      End Select
    Next i

    URLEncode = Join(result, "")
  End If
End Function

Assicurati di avere un riferimento alla Microsoft ActiveX Data Objects Library affinché funzioni.

E il tuo codice diventerebbe:

Sub SpecialLetters()
Dim objIe As Object

Set objIe = CreateObject("InternetExplorer.Application")
objIe.Visible = True

objIe.navigate "http://www.google.com/search?hl=en&ie=UTF-8&q=" & URLEncode(Sheets("Sheet1").Range("A1").Value)
    
End Sub
3 FaneDuru Aug 23 2020 at 15:33

Prova EncodeURLla funzione, per favore (funziona nelle installazioni di Office successive alla versione 2010):

Sub SpecialLetters()
Dim objIe As Object

Set objIe = CreateObject("InternetExplorer.Application")
objIe.Visible = True

  objIe.navigate "http://www.google.com/search?hl=en&ie=UTF-8&q=" & _
         WorksheetFunction.EncodeURL(Sheets("Sheet1").Range("A1").Value)
End Sub