Question

VB编一个程序，有个命令按钮和文本框，点一下会弹出框选择word文档，读取里面的内容显示在一个文本框中

已经添加了必要的部件和引用
Private Sub Command1_Click()
Dim patha As String '目录名,文件名
CommonDialog1.ShowOpen
patha = CommonDialog1.FileName
Txet1.Text=readall(patha) '主函数调用
End Sub
Public Function readall(ByVal patha As String) As String
Dim fname As String, te() As String '文件列表数组
Dim i As Long, n As Long, stemp As String
fname = Dir(patha, vbDirectory)
Do While fname <> "" '遍历目录
If LCase(Right(fname, 4)) = ".doc" Then
ReDim Preserve te(n): te(n) = patha & fname: n = n + 1
End If
fname = Dir()
Loop '获取文件列表完毕
On Error Resume Next
For i = 0 To UBound(te)
DoEvents
Open te(i) For Input As #121 '读
Do While Not EOF(121)
Line Input #121, stemp
readall = readall & stemp & vbNewLine
Loop
Close #121
Next i 'for语句
End Function
大神看看哪里出错了啊，每次运行都卡主
或者哪位大神帮忙写一个程序实现这个功能，如果我的错误实在很多没法改的话，谢啦

Answer 1

我修改了一下

Private Sub Command1_Click()
Dim patha As String '目录名,文件名
    CommonDialog1.Filter = "word文档|*.doc"
    CommonDialog1.ShowOpen
    patha = CommonDialog1.FileName
    dq (patha) '主函数调用
End Sub
Function dq(a As String)
Dim length As Long
Dim i As Long
Dim s As String
    Set oApp = CreateObject("Word.Application")
    oApp.Visible = False
    Set oDoc = oApp.Documents.Open(a)
    length = oDoc.Content.StoryLength
    Content = oDoc.Content.Text
For i = 1 To length
    If Mid$(Content, i, 1) = Chr$(13) Then
         s = s + vbCrLf
    Else
         s = s + Mid$(Content, i, 1)
    End If
    DoEvents  '让程序响应系统指令，防止锁死
Next i

oDoc.Close True
oApp.Quit False
Text1 = s
End Function

追问

vb实时错误429 ActiveX部件不能创建对象
这是为什么啊