网页或VB中操作word的方法
这段代码给我帮了很大的忙，希望他能帮到更多的人！
1
Public Function copy_mb(file1, file2path) As String
2Dim fso As Object
3Dim name
4name = Date & ((Timer() - 0.0001)) * 10000
5Set fso = CreateObject("Scripting.FileSystemObject"[img]/images/wink.gif[/img]
6Set f2 = fso.getfile(file1)
7f2.Copy (file2path & name & ".doc"[img]/images/wink.gif[/img]
8Set f2 = Nothing
9Set fso = Nothing
10copy_mb = file2path & name & ".doc"
11End Function
12
13
14Public Function del_file(filename) As Boolean
15Dim fso As Object
16Set fso = CreateObject("Scripting.FileSystemObject"[img]/images/wink.gif[/img]
17Set f2 = fso.getfile(filename)
18f2.Delete
19Set f2 = Nothing
20Set fso = Nothing
21End Function
22
23
24Public Function word_exe(filename, find_str, change_str) As String
25Dim wdapp As New Word.Application
26On Error GoTo e1
27Dim f_str() As String, c_str() As String, i As Integer
28wdapp.Visible = True
29wdapp.Documents.Open filename
30f_str = Split(find_str, "|"[img]/images/wink.gif[/img]
31c_str = Split(change_str, "|"[img]/images/wink.gif[/img]
32For i = 0 To UBound(f_str)
33If Len(c_str(i)) < 255 Then
34wdapp.ActiveDocument.Content.Find.Execute f_str(i), , True, , , , , , , c_str(i), 2
35Else
36Dim j As Integer, n As Integer
37If (Len(c_str(i)) Mod (254 - Len(f_str(i)))) > 0 Then
38 j = Int(Len(c_str(i)) / (254 - Len(f_str(i)))) + 1
39 Else
40 j = Int(Len(c_str(i)) / (254 - Len(f_str(i))))
41 End If
42
43 For n = 1 To j
44 If n <> j Then
45 wdapp.ActiveDocument.Content.Find.Execute f_str(i), , True, , , , , , , Mid(c_str(i), (n - 1) * (254 - Len(f_str(i))) + 1, 254 - Len(f_str(i))) & f_str(i), 2
46 Else
47 wdapp.ActiveDocument.Content.Find.Execute f_str(i), , True, , , , , , , Mid(c_str(i), (n - 1) * (254 - Len(f_str(i))) + 1, Len(c_str(i)) - (n - 1) * (254 - Len(f_str(i)))), 2
48 End If
49 Next n
50End If
51
52Next i
53
54wdapp.ActiveDocument.Save
55wdapp.ActiveDocument.Close
56wdapp.Quit
57
58Set wdapp = Nothing
59word_exe = "OK"
60Exit Function
61
62e1:
63wdapp.Quit
64Set wdapp = Nothing
65Dim ErrMsg As String
66ErrMsg = "Error Number:" & Err.Number & "<br><br>"
67ErrMsg = ErrMsg & "Error Source:" & Err.Source & "<br><br>"
68ErrMsg = ErrMsg & "Error Description:" & Err.Description & "<br><br>"
69word_exe = ErrMsg
70Exit Function
71
72End Function
73
74
75
76Public Function open_word(filename)
77Dim wdapp As New Word.Application
78wdapp.Visible = True
79wdapp.Documents.Open filename
80End Function
81
82
83
84Public Function copy_file(file1, file2, openstr) As String
85Dim fso As Object
86Set fso = CreateObject("Scripting.FileSystemObject"[img]/images/wink.gif[/img]
87Set f2 = fso.getfile(file1)
88f2.Copy (file2)
89Set f2 = Nothing
90Set fso = Nothing
91copy_file = file2
92If openstr = "yes" Then
93Call open_word(file2)
94End If
95End Function
96
97
98
99Public Function open_new(filename) As String
100Dim wpsapp As New Word.Application
101wpsapp.Documents.Add
102wpsapp.Documents(1).SaveAs filename
103wpsapp.Documents.Open filename
104wpsapp.Visible = True
105open_new = filename
106End Function
107
108
109
110Public Function copy_content(filename) As String
111Dim wdapp As New Word.Application
112wdapp.Visible = False
113wdapp.Documents.Open filename
114wdapp.Selection.WholeStory
115copy_content = wdapp.Selection.Text
116wdapp.ActiveDocument.Close
117wdapp.Quit
118Set wdapp = Nothing
119End Function
120
121
122
123Public Function copy_content2(filename) As String
124Dim wdapp As New Word.Application
125wdapp.Visible = False
126wdapp.Documents.Open filename
127wdapp.Selection.WholeStory
128wdapp.Selection.Copy
129copy_content2 = "已复制内容到剪贴板!!"
130wdapp.ActiveDocument.Close
131wdapp.Quit
132Set wdapp = Nothing
133End Function
134
135
136
137
138Public Sub create_obj(a, b, c)
139Dim obj As New WebFile
140 Call obj.HTTPPutFileEx(a, b, c)
141Set obj = Nothing
142End Sub
143
144
145
146Public Sub get_obj(a, b, c)
147Dim obj As New WebFile
148 Call obj.HTTPGetFile(a, b, c)
149End Sub
150
151
152
153
154vbscript中的处理方法：
155=========================================
156
157以下内容为程序代码:
158
159<script language="vbscript">
160
161On Error Resume Next
162
163Dim wApp
164
165Set wApp = CreateObject("Word.Application"[img]/images/wink.gif[/img]
166If Err.number > 0 Then
167Alert "没法保存为Word文件,请正确安装Word软件"
168else
169wApp.visible = True
170//
.操作代码！
171end if
172
173
174
Public Function copy_mb(file1, file2path) As String2
Dim fso As Object3
Dim name4
name = Date & ((Timer() - 0.0001)) * 100005
Set fso = CreateObject("Scripting.FileSystemObject"[img]/images/wink.gif[/img]6
Set f2 = fso.getfile(file1)7
f2.Copy (file2path & name & ".doc"[img]/images/wink.gif[/img]8
Set f2 = Nothing9
Set fso = Nothing10
copy_mb = file2path & name & ".doc"11
End Function12
13
14
Public Function del_file(filename) As Boolean15
Dim fso As Object16
Set fso = CreateObject("Scripting.FileSystemObject"[img]/images/wink.gif[/img]17
Set f2 = fso.getfile(filename)18
f2.Delete19
Set f2 = Nothing20
Set fso = Nothing21
End Function22
23
24
Public Function word_exe(filename, find_str, change_str) As String25
Dim wdapp As New Word.Application26
On Error GoTo e127
Dim f_str() As String, c_str() As String, i As Integer28
wdapp.Visible = True29
wdapp.Documents.Open filename30
f_str = Split(find_str, "|"[img]/images/wink.gif[/img]31
c_str = Split(change_str, "|"[img]/images/wink.gif[/img]32
For i = 0 To UBound(f_str)33
If Len(c_str(i)) < 255 Then34
wdapp.ActiveDocument.Content.Find.Execute f_str(i), , True, , , , , , , c_str(i), 235
Else36
Dim j As Integer, n As Integer37
If (Len(c_str(i)) Mod (254 - Len(f_str(i)))) > 0 Then38
j = Int(Len(c_str(i)) / (254 - Len(f_str(i)))) + 139
Else40
j = Int(Len(c_str(i)) / (254 - Len(f_str(i))))41
End If42
43
For n = 1 To j44
If n <> j Then45
wdapp.ActiveDocument.Content.Find.Execute f_str(i), , True, , , , , , , Mid(c_str(i), (n - 1) * (254 - Len(f_str(i))) + 1, 254 - Len(f_str(i))) & f_str(i), 246
Else47
wdapp.ActiveDocument.Content.Find.Execute f_str(i), , True, , , , , , , Mid(c_str(i), (n - 1) * (254 - Len(f_str(i))) + 1, Len(c_str(i)) - (n - 1) * (254 - Len(f_str(i)))), 248
End If49
Next n50
End If51
52
Next i53
54
wdapp.ActiveDocument.Save55
wdapp.ActiveDocument.Close56
wdapp.Quit57
58
Set wdapp = Nothing59
word_exe = "OK"60
Exit Function61
62
e1:63
wdapp.Quit64
Set wdapp = Nothing65
Dim ErrMsg As String66
ErrMsg = "Error Number:" & Err.Number & "<br><br>"67
ErrMsg = ErrMsg & "Error Source:" & Err.Source & "<br><br>"68
ErrMsg = ErrMsg & "Error Description:" & Err.Description & "<br><br>"69
word_exe = ErrMsg70
Exit Function71
72
End Function73
74
75
76
Public Function open_word(filename)77
Dim wdapp As New Word.Application78
wdapp.Visible = True79
wdapp.Documents.Open filename80
End Function81
82
83
84
Public Function copy_file(file1, file2, openstr) As String85
Dim fso As Object86
Set fso = CreateObject("Scripting.FileSystemObject"[img]/images/wink.gif[/img]87
Set f2 = fso.getfile(file1)88
f2.Copy (file2)89
Set f2 = Nothing90
Set fso = Nothing91
copy_file = file292
If openstr = "yes" Then93
Call open_word(file2)94
End If95
End Function96
97
98
99
Public Function open_new(filename) As String100
Dim wpsapp As New Word.Application101
wpsapp.Documents.Add102
wpsapp.Documents(1).SaveAs filename103
wpsapp.Documents.Open filename104
wpsapp.Visible = True105
open_new = filename106
End Function107
108
109
110
Public Function copy_content(filename) As String111
Dim wdapp As New Word.Application112
wdapp.Visible = False113
wdapp.Documents.Open filename114
wdapp.Selection.WholeStory115
copy_content = wdapp.Selection.Text116
wdapp.ActiveDocument.Close117
wdapp.Quit118
Set wdapp = Nothing119
End Function120
121
122
123
Public Function copy_content2(filename) As String124
Dim wdapp As New Word.Application125
wdapp.Visible = False126
wdapp.Documents.Open filename127
wdapp.Selection.WholeStory128
wdapp.Selection.Copy129
copy_content2 = "已复制内容到剪贴板!!"130
wdapp.ActiveDocument.Close131
wdapp.Quit132
Set wdapp = Nothing133
End Function134
135
136
137
138
Public Sub create_obj(a, b, c)139
Dim obj As New WebFile140
Call obj.HTTPPutFileEx(a, b, c)141
Set obj = Nothing142
End Sub143
144
145
146
Public Sub get_obj(a, b, c)147
Dim obj As New WebFile148
Call obj.HTTPGetFile(a, b, c)149
End Sub150
151
152
153
154
vbscript中的处理方法：155
=========================================156
157
以下内容为程序代码:158
159
<script language="vbscript">160
161
On Error Resume Next162
163
Dim wApp164
165
Set wApp = CreateObject("Word.Application"[img]/images/wink.gif[/img]166
If Err.number > 0 Then167
Alert "没法保存为Word文件,请正确安装Word软件"168
else169
wApp.visible = True 170
//.操作代码！171
end if172
173
174
