vba打开本地htm并全选复制后粘贴文本至新建excel，如何完善代码？

文件夹中有多个本地htm的网页，想要：

逐个打开htm；
全选htm内容；
新建工作簿，命名与htm名字一样；
将htm全选内容粘贴至工作簿，但仅粘贴为“匹配目标格式”；
要求：不需要原网页的诸如背景、颜色等格式，但涉及比较长的数字，能粘贴为文本格式，而不是粘贴后显示科学计数且自动将后几位变为0。

目前写了一半代码，出现要么粘贴了原网页的所有格式和内容，要么无法粘贴，要么粘贴时涉及长数字的自动变为了科学计数。恳请大家指教！

Public Sub vba网页复制粘贴()
fn = Dir(ThisWorkbook.Path & "\*htm")
On Error Resume Next
Set xmlhttp = Nothing
Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
LI = ThisWorkbook.Path & "\" & fn
With xmlhttp
        .Open "get", LI, False
        .Send
        tem = .responsetext
End With
With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText tem
    .PutInClipboard
End With

Workbooks.Add
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & fn & ".xlsx"

Cells.Select
Selection.NumberFormatLocal = "@"
Range("A1").Select
ActiveSheet.PasteSpecial.PasteSpecial (xlPasteValues) '运行后仍未粘贴到excel中，如直接使用activesheet.paste则粘贴了网页的所有格式。
    
End Sub

您可以尝试以下代码来实现您的需求：

Public Sub vba网页复制粘贴()
    Dim fn As String
    Dim xmlhttp As Object
    Dim tem As String
    Dim wb As Workbook
    Dim ws As Worksheet
    
    fn = Dir(ThisWorkbook.Path & "\*htm")
    
    Do While Len(fn) > 0
        ' 逐个打开htm文件
        Set xmlhttp = CreateObject("Microsoft.XMLHTTP")
        With xmlhttp
            .Open "get", ThisWorkbook.Path & "\" & fn, False
            .Send
            tem = .responsetext
        End With
        
        ' 新建工作簿并将htm内容粘贴到新建的工作簿
        Set wb = Workbooks.Add
        Set ws = wb.Sheets(1)
        ws.Range("A1").Value = tem
        
        ' 调整单元格格式
        ws.Cells.NumberFormatLocal = "@"
        ws.Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
        
        ' 保存工作簿并关闭
        wb.SaveAs Filename:=ThisWorkbook.Path & "\" & Replace(fn, ".htm", ".xlsx"), FileFormat:=xlOpenXMLWorkbook
        wb.Close False
        
        ' 处理下一个htm文件
        fn = Dir
    Loop
    
End Sub

代码中使用了一个循环来处理文件夹中的每个htm文件。在每次循环中，先使用XMLHTTP对象打开htm文件并将其内容读取为字符串。接着，使用Workbooks.Add新建一个工作簿，并将读取到的htm内容粘贴到新建工作簿的第一个单元格。之后，调整单元格格式为文本格式，并将空格删除，以避免长数字自动变为科学计数。最后，将工作簿保存为xlsx格式，并关闭工作簿。循环会继续处理下一个htm文件，直到所有htm文件都处理完毕。

注意，由于将空格删除可能会导致某些单元格中的文本对齐出现问题，因此您需要根据您的具体需求来决定是否需要这一步操作。如果不需要删除空格，可以将以下两行代码删除：


ws.Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
ws.Cells.NumberFormatLocal = "@"