VBscript在word中添加图片!!!

最新推荐文章于 2022-11-01 17:26:13 发布

yxtyxt3311

最新推荐文章于 2022-11-01 17:26:13 发布

阅读量3k

点赞数

CC 4.0 BY-SA版权

分类专栏： HTML ASP 文章标签： vbscript stylesheet server processing function javascript

本文链接：https://blog.youkuaiyun.com/yxtyxt3311/article/details/597946

ASP 同时被 2 个专栏收录

25 篇文章

订阅专栏

HTML

22 篇文章

订阅专栏

这篇博客介绍了一种使用VBScript在Word文档中批量添加图片的方法。通过JavaScript获取图片数据，然后利用VBScript创建Word应用并插入图片，最终生成包含图片的Word文档。用户在网页端操作后，数据处理完毕会弹出提示。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

<HTML>
<HEAD>
<meta HTTP-EQUIV="Content-Type" content="text/html; charset=gb_2312-80">
<link rel="stylesheet" type="text/css" href="edit.css">
<title>保存为Word文档</title>
</HEAD>
<script language="javascript">
window.returnValue=0
</script>
<BODY>
<font color="#000080"><strong><div id="strHint" align="center">数据处理中,请等待...<br>
Data processing, please wait...</div></strong></font><font color="#0080C0">

<%
Function GetUrl()
On Error Resume Next
Dim strTemp
If LCase(Request.ServerVariables("HTTPS")) = "off" Then
strTemp = "http://"
Else
strTemp = "https://"
End If
strTemp = strTemp & Request.ServerVariables("SERVER_NAME")
If Request.ServerVariables("SERVER_PORT") <> 80 Then
strTemp = strTemp & ":" & Request.ServerVariables("SERVER_PORT")
end if
GetUrl = strTemp
End Function
set objcn = server.CreateObject("gdcom.database")
set rs = server.CreateObject("ADODB.Recordset")
set fso = Server.Createobject("Scripting.FileSystemObject")
set stm=server.createobject("ADODB.Stream")
kch=trans(request.QueryString("kch"))
kch="5201000100002005120001"
links=GetUrl
'response.Write(Server.mappath("."))
'response.end
strsql="select * from xcpic where kch='"&kch&"' and qtype='现场照片' order by lrsj"

'strSQL="select unitname from tblunit where unitid='"&session("unitid")&"'"
set rs = objcn.RunSQLReturnRS(strSQL)
if rs.recordcount=0 then
response.Write("<script language=javascript>alert('暂无现场图片!');window.opener=null;window.close();</script>")
response.end
end if
tablerow=rs.recordcount*2
execute "dim tu("&rs.recordcount&","&rs.recordcount&")"
rs.movefirst
for i=1 to tablerow/2
tu(i,1)=rs("title")
If Not IsNull(rs("wjlj")) Then
  AttachmentFile = Server.mappath(".") & "/photo/" & Session.SessionID & "_PICTURE[" & i & "].JPG"
  stm.Mode = 3
  stm.Type = 1
  stm.Open
  stm.Write rs("wjlj")
  stm.SaveToFile AttachmentFile, 2
  stm.Close
End If
AttachmentFile1=links&"/xk/photo/" & Session.SessionID & "_PICTURE[" & i & "].JPG"
'If fso.FileExists(AttachmentFile) Then
' fso.DeleteFile AttachmentFile
'End If
tu(i,2)=AttachmentFile1
rs.movenext
next
rs.close
%>

Set rngCurrent = wApp.Application.ActiveDocument.Paragraphs(1).Range
Set tabCurrent = wApp.Application.ActiveDocument.Tables.Add(rngCurrent,<%=tablerow%>,1)
<%for i=1 to tablerow/2%>
wApp.Application.ActiveDocument.Tables(1).Rows(<%=(i*2-1)%>).Cells(1).Range.InlineShapes.AddPicture "<%=tu(i,2)%>", False, True
wApp.Application.ActiveDocument.Tables(1).Rows(<%=(i*2-1)%>).Cells(1).Range.ParagraphFormat.alignment=1
wApp.Application.ActiveDocument.Tables(1).Rows(<%=(i*2)%>).Cells(1).Range.InsertAfter "<%=tu(i,1)%>"
wApp.Application.ActiveDocument.Tables(1).Rows(<%=(i*2)%>).Cells(1).Range.ParagraphFormat.alignment=1
<%next%>
end if
</script>

/////最后的删除不要了,是异步的,这么快删除,图片还没导入到word中...
<%
apppath=server.mappath(".")
apppath=apppath&"/photo/"
links1=links&"/xk/photo/"
for i=1 to tablerow/2
filepic=replace(tu(i,2),links1,apppath)
If fso.FileExists(filepic) Then
fso.DeleteFile filepic
End If
next
%>
<center><br><strong>数据处理完毕!</strong></center>

</BODY>
</HTML>