如何将 HTML 源代码复制到工作表

Question

所以我有这个代码，它将整个 HTML 源代码剥离到列中的下一个单元格。问题是我用来提取 HTML 源代码的网页有一些波兰语字母，如“ą”、“ś”等。 有没有办法用那些波兰字母粘贴代码？现在我得到了一些带有问号等的疯狂方块。有什么建议吗？

ps。感谢@pizzettix https://stackoverflow.com/users/6254609/pizzettix

，我有这个代码

Sub audycje()
    
    Dim strona As Object
    Dim adres As String
    Dim wb As Workbook
    Dim a As Object
    Dim str_var As Variant
    
    Set wb = ThisWorkbook
    adres = InputBox("Podaj adres strony")
    If adres = "" Then
       MsgBox ("Nie podano strony do zaladowania")
    Exit Sub
    End If
    
    Set strona = CreateObject("htmlfile")   'Create HTMLFile Object
    With CreateObject("msxml2.xmlhttp")  'Get the WebPage Content
       .Open "GET", adres, False
       .send
       strona.Body.Innerhtml = .responseText
    End With
    
    'Split_with_delimiter_newline
    split_var = Split(strona.Body.Innerhtml, Chr(10))
    
    Application.ScreenUpdating = False
    
    For i = 0 To UBound(split_var, 1)
       Cells(2 + i, 2).Value2 = split_var(i)
    Next i
    
    Application.ScreenUpdating = True
    
    End Sub

Answer 1

对于编码问题，请在开头添加（Office 2013 及更高版本中可用的功能）：

Mystring = WorksheetFunction.EncodeURL(Mystring)

在Extract content of div from Google Translate with VBA查看我的原始帖子

如果您的 Office 版本早于 2013 年，或者如果您需要分发给可能拥有旧版本的用户，请使用： How can I URL encode a string in Excel VBA?

像这样更改您的代码：

Dim Mystring as string
For i = 0 To UBound(split_var, 1)
   Mystring= split_var(i)
   Mystring = WorksheetFunction.EncodeURL(Mystring)
   Cells(2 + i, 2).Value2 = Mystring
Next i

Answer 2

方案一：您可以使用Excel中的“获取外部数据”功能来导入html页面。

将单元格中的数据放入单元格中，可以使用以下函数将奇数字符或重音字符替换为常规字符。

下面是我用常规字符替换重音字符的函数：

Function StripAccent(thestring As String)
' Replaces accented characters with regular characters
  Dim A As String * 1
  Dim B As String * 1
  Dim i As Integer
  Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåáçèéêëéìíîïðñòóôõöøùúûüýÿ"
  Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaaceeeeeiiiidnoooooouuuuyy"
  For i = 1 To Len(AccChars)
    A = Mid(AccChars, i, 1)
    B = Mid(RegChars, i, 1)
    thestring = Replace(thestring, A, B)
    thestring = Application.WorksheetFunction.Trim(thestring)
  Next
  StripAccent = thestring
End Function 

选项 2： 另一个选项是将文档作为“Unicode 文本”导入。这应该会保留波兰语字符。

为了测试，我从网页复制了一个波兰语段落，并使用选择性粘贴>>Unicode 文本将其粘贴到 Excel 电子表格单元格中，它保留了波兰语字符。

Answer 3

经过一个月的搜索，我终于找到了！ 下面的代码可以解决问题:)

由于版主无故删除我的答案，再次发帖……

下面的代码完成了我一直在寻找的工作

Sub audycje()
    Dim strona As Object
    Dim adres As String
    Dim wb As Workbook
    Dim str_var As Variant
    Dim Mystring As String
    
    Set wb = ThisWorkbook
    adres = InputBox("Podaj adres strony")
    If adres = "" Then
       MsgBox ("Nie podano strony do zaladowania")
    Exit Sub
    End If
    
    Set strona = CreateObject("htmlfile")   'Create HTMLFile Object
    With CreateObject("msxml2.xmlhttp")  'Get the WebPage Content
       .Open "GET", adres, False
       .setRequestHeader "Content-Type", "text/plain;charset=UTF-8"
       .send
       strona.body.innerHTML = StrConv(.responseBody, vbUnicode)
    End With
    
    'Split_with_delimiter_newline
    split_var = Split(strona.body.innerHTML, Chr(10))
    
    Application.ScreenUpdating = False
    
    For i = 0 To UBound(split_var, 1)
    wb.Worksheets("Dane").Cells(2 + i, 2).Value2 = split_var(i)
    Next i
        
    Application.ScreenUpdating = True