Sub AAA()
Dim FilePath As String '要读取的文件路径
Dim S1 As String '文档的内容
Dim S2 As String '提取到的内容
Dim Ar As Variant '用于保存最终结果
Dim L1 As Long '记录当前查找到的字符位置
FilePath = Application.GetSaveAsFilename(fileFilter:="Word文档,*.doc;*
.docx")
If FilePath = "False" Then MsgBox "您没有选择文件,将退出程序。": Exit Sub
With CreateObject("word.application")
With .Documents.Open(FilePath, True, True)
S1 = .Content
.Close False
End With
.Quit
End With
L1 = InStr(S1, "<") '第一个 < 位置
Do Until L1 = 0
If Len(S2) <> 0 Then
S2 = S2 & "Crazy0qwer" & Mid(S1, L1 + 1, InStr(L1, S1, ">") - L1 - 1)
Else
S2 = Mid(S1, L1 + 1, InStr(L1, S1, ">") - L1 - 1)
End If
L1 = InStr(L1 + 1, S1, "<")
Loop
Ar = Split(S2, "Crazy0qwer")
Range("A1").Resize(UBound(Ar) + 1) = Application.Transpose(Ar)
End Sub