[Lotus script] -Word匯出．改

續匯出Wpord程式
再多一個匯出「圖像」∼ 從Richtext中取出並轉到Word裡面..



按鈕事件：

Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document

Dim m_to$,m_dy$,m_dm$,m_dd$,m_no$,m_sp$, m_sec$,m_ath$,m_sub$,m_body$,m_main$,m_bend$,m_img$
m_to$ = doc.Missive_To(0) '受文者
m_dy$ = doc.Missive_date(0) '年

...

m_img$ = GetImagePath("C:\Tmp\") '圖章

'匯出
Call WordOut(m_to$,m_dy$,m_dm$,m_dd$,m_no$,m_sp$, m_sec$,m_ath$,m_sub$,m_body$,m_main$,m_bend$,m_img$)
End Sub

將圖像先輸出至硬碟中：

Function GetImagePath(tmpPath As String) As String
'取得圖像
Dim ws As New NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim item As Variant
Dim rtnav As NotesRichTextNavigator
Dim imgobj As NotesEmbeddedObject
Dim fn As String
Dim rtn As String

Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
Set item = doc.GetFirstItem("Missive_UIMAGE")
Set rtnav = item.CreateNavigator

If Not rtnav.FindLastElement(RTELEM_TYPE_FILEATTACHMENT) Then
rtn = "nodata.gif"
Else
Call rtnav.FindFirstElement(RTELEM_TYPE_FILEATTACHMENT)
Forall embobj In item.EmbeddedObjects
If embobj.Type = EMBED_ATTACHMENT Then
fn = embobj.name
Call embobj.ExtractFile( tmpPath & "\" & fn )
End If
End Forall
rtn = fn
End If
If (rtn="") Then rtn = "nodata.gif"
GetImagePath =rtn
End Function

插入Word的Dot範本中：

Sub WordOut( M_To As String, M_DY As String, M_DM As String, M_DD As String, M_NO As String, M_SP As String, M_SEC As String,M_AH As String,M_Sub As String,M_Body As String,M_MAIN As String,M_BEND As String,M_IMG As String)
Dim session As New NotesSession
Dim DotPath As String
Set db=session.CurrentDatabase
Set wdoc=session.DocumentContext

'tmpPath=Environ$("temp") & "\"
tmpPath = "C:\Tmp\"
DotPath=tmpPath & "missive_sample_v3.dot" '設定路徑

Set oWord = CreateObject("Word.Application")
oWord.Application.Visible = True
oWord.documents.Add DotPath, False
Set WordDoc = oWord.activedocument
'=======Go to bookmark=======
WordDoc.Bookmarks("TO").Select
Call oWord.Selection.TypeText(M_To)
WordDoc.Bookmarks("YY").Select
Call oWord.Selection.TypeText(M_DY)

...

WordDoc.Bookmarks("IMG").Select
oWord.Selection.InlineShapes.AddPicture(tmpPath & "\" & M_IMG)
'oWord.Selection.TypeParagraph
'Selection.InlineShapes.AddPicture FileName:= _
'"C:\Documents and Settings\All Users\Documents\My Pictures\範例圖片\Water lilies.jpg" _
', LinkToFile:=False, SaveWithDocument:=True
''==========================
'oWord.documents(1).SaveAs "c:\Tmp\WM20101223.doc"
End Sub

--
看到、想到、說到、做到　
能夠填平大海的誓言，也比不上邁出一步的價值　
是以吾輩此生，再無任何誓言