Excel ActiveSheet.QueryTables.Add и не-ASCII символы - PullRequest
0 голосов
/ 26 октября 2018

Я использую следующий код для получения страницы "cusp" с www.merriam-webstercom.Это работало хорошо, за исключением того, что фонетические символы не отображались должным образом.У меня есть такие вещи: \ ˈkÉ ™ -ËŒspÄt, -spÉ ™ t.Пытаясь вставить фонетические символы на эту страницу, я получал те же самые писанины.

Я искал в Интернете, но не получил никаких полезных подсказок.

Есть мысли?Спасибо.

Sub import_from_web(ByVal lookup_word As String)

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;https://www.merriam-webster.com/dictionary/" & lookup_word,   Destination:= _
    Range("$A$1"))
    .Name = "d"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .TextFilePlatform = xlMSDOS
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With
End Sub

1 Ответ

0 голосов
/ 28 октября 2018

В итоге я использовал совершенно другой подход. Вместо создания ссылки я просто открыл страницу, скопировал и вставил страницу в Excel.

Спасибо этой теме:

Excel2010: не удается выполнить PasteSpecial при копировании из IE

Sub search_paste(ByRef IE As Object, ByVal lookup_word As String)

' this sub can handle non-ASCII characters
' it accepts a word from the calling sub and searches the word at Merian-Webster
' it then copies the web page and pastes to the ActiveSheet for further processing

With IE
    .Visible = True
'        .Navigate 
    .Navigate "https://www.merriam-webster.com/dictionary/" & lookup_word ' open the page containing the search word

    Do Until .ReadyState = 4: DoEvents: Loop
End With
DoEvents
IE.ExecWB 17, 0 '// SelectAll
IE.ExecWB 12, 2 '// Copy selection
ActiveSheet.PasteSpecial link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True

End Sub
...