作者 主題: 使用vb 6.0 或 vb script 讀取範本.dot,然後替換部分內容,存成.doc檔  (閱讀 2195 次)

0 會員 與 1 訪客 正在閱讀本文。

小徒兒

  • 鑽研的研究生
  • *****
  • 文章數: 621
    • 檢視個人資料
using vb or vb script to open the word template : 新進人員名單.dot
then replace some parts like the member name and date
then save it as test.doc

代碼: [選擇]



Dim objWord As Word.Application


Private Sub Command1_Click()

On Error GoTo LocalHandler

Set objWord = New Word.Application
objWord.Documents.Open App.Path & "\新進人員名單.dot"
objWord.ActiveWindow.WindowState = wdWindowStateNormal

Dim yearString As Integer
Dim monthString As Integer
Dim dayString As Integer
Dim Name As String


Name = "汪測試"
Position = "資訊部三等專員"
OnJobDate = "94.10.10"
IssueNo = "9409019"

yearString = DatePart("yyyy", Date) - 1911
monthString = DatePart("m", Date)
dayString = DatePart("d", Date)


With objWord.ActiveDocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "日  期:"
        .Replacement.Text = "日  期:" & yearString & "." & monthString & "." & dayString
        .Forward = True
        .Wrap = Word.WdFindWrap.wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue

End With


With objWord.ActiveDocument.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "許是我"
        .Replacement.Text = Name
        .Forward = True
        .Wrap = Word.WdFindWrap.wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
End With


With objWord.ActiveDocument.Content.Find
       
        .Text = "營業部經理"
        .Replacement.Text = Position
        .Forward = True
        .Wrap = Word.WdFindWrap.wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
End With

With objWord.ActiveDocument.Content.Find
       
        .Text = "94.09.02"
        .Replacement.Text = OnJobDate
        .Forward = True
        .Wrap = Word.WdFindWrap.wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
End With


With objWord.ActiveDocument.Content.Find
       
        .Text = "測試公司人字第9409014號"
        .Replacement.Text = "測試公司第" & IssueNo & "號"
        .Forward = True
        .Wrap = Word.WdFindWrap.wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
End With











objWord.ActiveDocument.SaveAs App.Path & "\test.doc"

objWord.Documents.Close SaveChanges:=wdDoNotSaveChanges

objWord.Quit SaveChanges:=wdDoNotSaveChanges

Set objWord = Nothing



'objWord.ActiveWindow.Close SaveChanges:=False
'Set objWord = Nothing

'With objWord.ActiveDocument.Content.Find
'    .Text = "日  期:94.09.07"
'    .Forward = True
'    .Execute
'    If .Found = True Then .Replacement.Text = "ggyy:"
'    .Execute
'    If .Found = True Then .Parent.Bold = False
'End With





Exit Sub

LocalHandler:

MsgBox Err.Description



End Sub






run, on your local host asp code
代碼: [選擇]


<html>
<head>
<%

path=server.mappath("opendoc.asp")
path=left(path,len(path)-11)
filenames=path&"test.doc"

w2="wApp.Documents.open"&chr(32)&chr(34)&filenames&chr(34)
w1="wApp.activedocument.saveAs"&chr(32)&chr(34)&filenames&chr(34)

%>
<script language="vbscript">
msgbox "test"
On Error GoTo 0
'生成指定文件名的Word文?

call main


Sub instead(word,Name,Position,OnJobDate,IssueNo)

Dim yearString
Dim monthString
Dim dayString


yearString = DatePart("yyyy", Date) - 1911
monthString = DatePart("m", Date)
dayString = DatePart("d", Date)

Set myRange = word.ActiveDocument.Content
 call myRange.Find.Execute("日  期:",false,false,false,false,false,false,false,false,"日  期:" & yearString & "." & monthString & "." & dayString,2)
 call myRange.Find.Execute("許小鴨",false,false,false,false,false,false,false,false,Name,2)
 call myRange.Find.Execute("喵喵部二等專員",false,false,false,false,false,false,false,false,Position,2)
 call myRange.Find.Execute("94.09.02",false,false,false,false,false,false,false,false,OnJobDate,2)
 call myRange.Find.Execute("測試人字第9409014號",false,false,false,false,false,false,false,false,"測試人字第" & IssueNo & "號",2)

End Sub



sub main()
msgbox "test"
Dim wApp
set wApp = CreateObject("Word.Application")
alert "<%response.write path%>"

if Err.number > 0 Then
Alert "文件是否存在"
else
wApp.visible = False
wApp.documents.open "<%response.write path%>新進人員名單.dot"


dim VarName,VarPosition,VarOnJobDate,VarIssueNo


VarName = "汪測試"
VarPosition = "資訊部三等專員"
VarOnJobDate = "94.10.10"
VarIssueNo = "9409019"

call instead(wApp,VarName,VarPosition,VarOnJobDate,VarIssueNo)

<%Response.write w1%>
wApp.documents.close 0
wApp.Quit 0
set wApp=nothing
end if

end sub

</script>

</head>
<body>
</body>
</hmtl>





*don't forget to add one virtual folder named:
 ShareFile, which use 匿名存取

*add the 新進人員名單.dot in this virtual folder
run on the server, vb script code
代碼: [選擇]


<%

path="http://172.16.200.83/ShareFile/"
filename=path & "test.doc"
%>

<Script Language="VBScript">
<!--

call main

Sub instead(Name,Position,OnJobDate,IssueNo)
                                        msgbox "test"
                                        Dim wApp
                                        set wApp = CreateObject("Word.Application")
                                        alert "<%response.write path%>"
                                       
                                        if Err.number > 0 Then
                                        Alert "文件是否存在"
                                        else
                                        wApp.visible = False
                                        msgbox "<%response.write path%>"
                                        wApp.documents.open "<%response.write path%>新進人員名單.dot"
                                       
                                 

Dim yearString
Dim monthString
Dim dayString


yearString = DatePart("yyyy", Date) - 1911
monthString = DatePart("m", Date)
dayString = DatePart("d", Date)

Set myRange = word.ActiveDocument.Content
 call myRange.Find.Execute("日  期:",false,false,false,false,false,false,false,false,"日  期:" & yearString & "." & monthString & "." & dayString,2)
 call myRange.Find.Execute("許小鴨",false,false,false,false,false,false,false,false,Name,2)
 call myRange.Find.Execute("喵喵部二等專員",false,false,false,false,false,false,false,false,Position,2)
 call myRange.Find.Execute("94.09.02",false,false,false,false,false,false,false,false,OnJobDate,2)
 call myRange.Find.Execute("測試人字第9409014號",false,false,false,false,false,false,false,false,"測試人字第" & IssueNo & "號",2)

w1="wApp.activedocument.saveAs"&chr(32)&chr(34)&filenames&chr(34)

<%Response.write w1%>
wApp.ActiveDocument.Printout
MsgBox "新進人員人事公告列印結束"
 
wApp.documents.close 0
wApp.Quit 0
set wApp=nothing
end if

End Sub

sub main
HRSerial = InputBox("請輸入人事公告文號!")
 
  If Len(HRSerial)=0 then
  msgbox "確定不產生人事內部公文"
 
  else
  msgbox "yes"
dim VarName,VarPosition,VarOnJobDate,VarIssueNo
VarName = "汪測試"
                                        VarPosition = "資訊部三等專員"
                                        VarOnJobDate = "94.10.10"
                                        VarIssueNo = HRSerial
                                       
                                       call instead(VarName,VarPosition,VarOnJobDate,VarIssueNo)

  end if
 
end sub