反向邮件合并，如何实现从word提取数据到excel中

痛痛痛痛

我们知道邮件合并，是把Excel的数据导入到word中，那么怎么实现反过来的效果，把word中的数据导入到Excel

比如原先邮件合并后的效果如下图，word中的示例之一：


如何把这个word中的数据导出到Excel中？不知道哪位大神做过这样的事？

zhanglei1371

太过简单，搜索下word提取到Excel的vba，大把大把大把的例子……

changhong8

老实讲，word中的查找替换就能搞定
Sub test()
Dim brr(1 To 10000, 1 To 3)
t = Timer
mypath = ThisWorkbook.Path & "\"
fn = Dir(mypath & "*.do*")
If fn = "" Then Exit Sub
Set doc = GetObject(mypath & fn)
istr = doc.Range.Text
Set r = CreateObject("vbscript.regexp")
r.Pattern = "\s+"
r.Global = True
istr = r.Replace(istr, "")
allpp = Split(istr, "亲爱的")
For Each k In allpp
    With r
        .Pattern = "(.+?)同学"
        .Global = True
        If .test(k) Then
            IName = .Execute(k)(0).submatches(0)
            .Pattern = "(英语|语文|数学)(?:|：)(\d+)"
            For Each mh In .Execute(k)
                num = num + 1
                brr(num, 1) = IName
                brr(num, 2) = mh.submatches(0)
                brr(num, 3) = mh.submatches(1)
            Next
        End If
    End With
   
Next
Shell "cmd.exe /c taskkill /im /t /f winword.exe"
Rows("2:10000").Clear
Range("a2").Resize(num, 3) = brr
With Range("a1").CurrentRegion
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .Borders.LineStyle = 1
End With
MsgBox Timer - t
End Sub