运行时错误"48"，加载DLL错误，是什么原因?怎么解决？

gwfzh

各位老师：

         想将同文件夹下的word文档复制到本表中，可是程序运行到下面代码“SetMyRange = .Range(StartRange, EndRange) ”语句处时，出现运行时错误"48"，加载DLL错误，怎么解决？是什么原因，请各位老师帮忙了！！！，谢谢！！！ wordtoexcel.rar (549 KB, 下载次数: 3)

2018-9-26 23:04 上传

点击文件名下载附件

1. 
   
2. Sub AlineInWord()  '逐行读取复制109行=TarLines = .BuiltinDocumentProperties("Number of lines").Value
   
3.     '    Dim WD As New Word.Application 'word程序的父对象'前期绑定,好处是在对象后输入句点可以给出快速提示，因为需要先引用对象，所以容易出现版本兼容问题。
   
4.     '    Dim Doc As Word.Document '子对象、word具体上档文档对象
   
5.     '    'Dim WD As Object  '后期绑定，没有提示，根据运行代码机器上对象的版本创建对象，兼容性好。
   
6.     Dim WD, Doc, MyRange As Word.Range
   
7.     Dim word行数, 读行号%, 每次读行数%, Excel行号%
   
8.     Dim MyPath$, FN$, cPath$, cFile$, I%, arr()
   
9.     Dim TarLines As Long, StartRange As Long, EndRange As Long, Str, krr()
   
10.     Application.ScreenUpdating = False
    
11.     krr() = Array("姓名", "年龄", "出生日期", "详细住址", "联系人", "联系电话", "人口数", "家庭劳动力数", "人年收入", "人均收入）", "医疗费用", "交通费", "食宿费", "附加费用", "本人误工损失", "家属的误工损失")
    
12.     '    Set WD = CreateObject("Word.Application")   '新建Word对象
    
13.    
    
14.     MyPath = ThisWorkbook.Path & ""
    
15.     Fp = ThisWorkbook.Path
    
16.     ReDim arr(1 To 10, 1 To 112)
    
17.     With CreateObject("word.application") '创建word进程
    
18.         .Visible = False '隐藏执行
    
19.         .AutomationSecurity = msoAutomationSecurityForceDisable
    
20.         .DisplayAlerts = False  '''取消警报提醒
    
21.         FN = Dir(Fp & "" & "*.doc")
    
22.         sText = Right(FN, 7) ' = "调查表.doc"
    
23.         Do While Right(FN, 9) = "个案调查表.doc"  '遍历WORD
    
24.             
    
25. '                Set Doc = .Documents.Open(ThisWorkbook.Path & "" & FN)
    
26. '            With Doc '.Documents.Open(Fp & "" & FN)   '打开目标word文档
    
27.             With .Documents.Open(Fp & "" & FN)   '打开目标word文档
    
28.                 n0 = n0 + 1
    
29.                 word行数 = .BuiltinDocumentProperties(wdPropertyLines).Value
    
30.                 TarLines = .BuiltinDocumentProperties("Number of lines").Value 'DOC文档的行数
    
31.                 lineStart = .GoTo(What:=wdGoToLine, Which:=wdGoToNext, Count:=1).End
    
32.                 m = .Range.ComputeStatistics(wdStatisticLines)
    
33.                 ReDim arr(1 To 10, 1 To TarLines)
    
34.                 每次读行数 = 1
    
35.                 '   Excel行号 = 2
    
36. '                StartRange = wdGoToLine
    
37.                 For 读行号 = 3 To TarLines
    
38.                     ' For 读行号 = 1 To LineCount
    
39.                     If .Content.End <= 1 Then Exit Sub '如果没有文档内容则退出宏
    
40.                     '   For 读行号 = 1 To word行数
    
41.                     '      With WD.Selection
    
42.                     '          .GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=读行号
    
43.                     '          .MoveDown wdLine, 每次读行数, wdExtend
    
44.                     '          If Val(.Text) > 0 Then
    
45.                     '             Range("A" & Excel行号) = .Text
    
46.                     '             Excel行号 = Excel行号 + 1
    
47.                     '          End If
    
48.                     'Str0 = .wdLine(读行号).Text '方法和数据成员未找到错误
    
49.                     StartRange = .GoTo(wdGoToLine, , 读行号).Start '指定行号的始点位置 '如果输入行号与DOC的总行数一致 , 则终点位置为文档末位置, 反之则为下一行的起点
    
50.                     EndRange = VBA.IIf(读行号 = TarLines, .Content.End, .GoTo(wdGoToLine, , 读行号 + 1).Start)
    
51.                     Set MyRange = .Range(StartRange, EndRange) '定义一个RANGE对象 '将开始到结束字符位置赋值给myRange对象
    
52.                     '      End With
    
53.                     '   Next
    
54.                     If InStr(1, MyRange, "√") > 0 Then
    
55.                         N = InStr(1, MyRange, "√") '对勾：ALT+小键盘41420  打叉：ALT+小键盘41409
    
56.                         Str = Mid(MyRange, N, 4)
    
57.                         arr(n0, I) = Str
    
58.                     End If
    
59.                     Sheets(2).Cells(读行号, 1) = Str0 ' MyRange
    
60.                 Next
    
61.                 .Close False  '关闭word文档，不保存。
    
62.                  Set Doc = Nothing
    
63.             End With
    
64.             FN = Dir()  ''下一个WORD的处理
    
65.         Loop
    
66.         .DisplayAlerts = True  '''显示警报
    
67.         .Visible = True '''可视
    
68.         .Quit  '''退出WORD进程
    
69.     End With
    
70.     Application.ScreenUpdating = True
    
71. End Sub
    

复制代码