在代理中利用VBA對word直接編輯後保存

在代理中利用VBA對word附件直接編輯後保存
步驟：
1、獲得附件，並拆分到服務器臨時目錄裏後再刪除附件
2、創建word對象，並打開臨時目錄裏的文件
3、編輯附件然後保存
4、將附件添加到文檔中並保存

Sub Initialize
 On Error Goto errhandle
 Dim session As NotesSession
 Dim cdb As NotesDatabase
 Dim collection As NotesDocumentCollection
 Dim doc As NotesDocument
 Dim richItem As NotesRichTextItem
 Dim item As NotesItem
 Dim i As Integer
 Dim j As Long
 Dim attachVar As Variant
 Dim attachObj As NotesEmbeddedObject
 
 Dim docApp As Variant
 Dim docDocs As Variant
 Dim docObj As Variant
 Dim range As Variant
 
 Dim tempFiles() As String
 Dim tempObj() As NotesEmbeddedObject
 Dim tempFile As String
 
 Set session = New NotesSession
 Set cdb = session.CurrentDatabase
 Set collection = cdb.Search(|form="fTest2" & @Attachments|,Nothing,0)
 For j = 1 To collection.Count
  Set doc = collection.GetNthDocument(j)
  attachVar = Evaluate(|@AttachmentNames|,doc)
  If attachVar(0) <> "" Then
   Redim tempFiles(0 To Ubound(attachVar)) As String
   For i = 0 To Ubound(attachVar)
    '保存附件名稱
    tempFile = "d:/"+attachVar(i)
    tempFiles(i) = tempFile
    '獲取附件
    Set attachObj = doc.GetAttachment(attachVar(i))
    Call attachObj.Activate(False)
    '拆離附件到臨時目錄
    attachObj.ExtractFile(tempFile)
    Set docApp = CreateObject("word.application")
    docApp.visible = False
    Set docDocs = docApp.documents
    docDocs.open tempFile
    Set docObj = docDocs(1)
    
    ''''''''在此對word進行修改''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    On Error Resume Next
    Set range = docObj.range(0)
    On Error Resume Next
    
    range.text = Cstr(Now)
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    docDocs.close
    '關閉word並保存
    docApp.quit(-1)
    Set range = Nothing
    Set docObj = Nothing
    Set docDocs = Nothing
    Set docApp = Nothing
    '刪除現有的附件
    Call attachObj.Remove
    Set attachObj = Nothing
   Next
   Call doc.Save(True,True)
   '重新添加附件
   Redim tempObj(0 To Ubound(tempFiles))
   Set item = doc.GetFirstItem("body")
   Call item.Remove
   Set richItem = doc.CreateRichTextItem("Body")
   For i = 0 To Ubound(tempFiles)
    Set tempObj(i) = richItem.EmbedObject(EMBED_ATTACHMENT,"",tempFiles(i))
   Next
   Call doc.Save(True,True)
   '刪除臨時附件
   For i = 0 To Ubound(tempFiles)
    Kill tempFiles(i)
   Next
  End If
  
 Next
 Exit Sub
errhandle:
 Msgbox Cstr(Erl) & "," & Error$
End Sub