VBA获取WORD数据

Sub 获取word的数据()
Dim sfname   As String
Dim strfilt   As String
Dim strtitle   As String
Dim docapp As word.Application
Dim pg   As word.paragraph
Dim i   As Long
Dim str1  As String
strfilt = "word文档(*.doc;*.docx;*.docm),*.doc;*.docx;*.docm,"
strtitle = "打开word文档"
sfname = Application.GetOpenFilename(filefilter:=strfilt, Title:=strtitle)
If sfname = "Fasle" Then Exit Sub
Set docapp = CreateObject("word.application")
docapp.document.Open sfname
i = 1
With docapp.activedocument
    For Each pg In .Paragraphs
        str1 = pg.Range.Text
        i = i + 1
        ActiveSheet.Cells(i, 1) = str1
    Next
End With
docapp.Quit
Set docapp = Nothing
End Sub