Dim app As New MSWord.Application
try
Dim fileName = "D:\问题\练习\选择题.docx"
Dim doc = app.Documents.Open(fileName)
Dim p As MSword.Paragraph, str1 As String, str2 As String,A As Integer,B As Integer
For Each p In Doc.Paragraphs
str1 = Left(p.Range.Text.ToString(), 5)
str2 = Left(p.Range.Text.ToString(), 4)
If str1 = "【选择题】" Then
A = p.Range.Start
ElseIf str2 = "【解析】" Then
B = p.Range.End
Doc.Range(A + 6, B).Copy
Dim d2 = app.Documents.Add
app.Selection.Paste
app.Selection.TypeBackspace
d2.SaveAs2("D:\问题\练习\x" & Left(d2.Paragraphs(1).Range.Text.ToString, 1) & ".docx")
d2.Close(0)
End If
Next
catch ex As exception
msgbox(ex.message)
finally
app.Quit
End try