[已解决]用VBA操作Lotus Notes发邮件的时候如何paste speical(rich text)

tonyibm

我们在用Lotus Notes发邮件的时候，比如从EXCEL里面复制了一些单元格，然后在邮件里面，选择菜单"edit" - "paste special" - 选择rich text,这时候就会粘贴到邮件中一个类似的表格形式，

但是我找了一圈，不知道在VBA中咋实现，

tonyibm

用richtextitem的appendtable方法搞定了，
代码贴出来共享一下，

[code=vb]
Sub aaaaaa()
Dim no As Object
Dim db As Object
Dim doc As Object
Dim fields As Object
Dim att() As String
Dim nrtn As Object
Dim x, y As Integer
Set no = CreateObject("notes.notessession") '建立和邮件的连接
Set db = no.CURRENTDATABASE '建立和邮件数据库的连接
Set doc = db.CREATEDOCUMENT '创建一个新的邮件
Set fields = doc.CREATERICHTEXTITEM("body") '设置新邮件的正文（附件）对象
Set nrtn = fields.CREATENAVIGATOR
fields.APPENDTABLE 11, 4
nrtn.FINDFIRSTELEMENT (RTELEM_TYPE_TABLECELL)
For x = 1 To 11
    For y = 1 To 4
   
        fields.BEGININSERT nrtn
        fields.APPENDTEXT Sheets(1).Cells(x, y).Value
        fields.ENDINSERT
        nrtn.FINDNEXTELEMENT RTELEM_TYPE_TABLECELL
        
    Next y
   
Next x
With doc '设置新邮件的除正文和附件外的其他信息
    .form = "Memo" '新邮件
    .sendto = "tonyhf@cn.ibm.com" '发送给
    .Subject = "this mail is just for testing" '主题
    .SAVEMESSAGEONSEND = True '是否保存发送的邮件到发件箱
    .postdate = DateAdd("d", 1, Date) '发送日期等于当天
    .SEND 0 '发送
End With
MsgBox "successfully sent out the mail!"
Set no = Nothing '释放内存
Set db = Nothing
Set doc = Nothing
Set fields = Nothing
Set nrtn = Nothing
End Sub

[/code]

allforone

感谢分享，学习了。

yucan20018

tonyibm 发表于 2012-5-20 20:31
用richtextitem的appendtable方法搞定了，
代码贴出来共享一下，

非常感谢你的分享，现在有个新的问题需要你的帮忙，我希望打开NOTES把附件加进去后，就停留在“新建便笺”的界面，不要自动发送出去，具体见附件，请帮忙确认是否可以实现，谢谢！

tonyibm

注意这一句：
Set aDataBase = anotes.GETDATABASE("", "C:\notes\data\mail3\tonyhf.nsf")
我这里是用的getdatabase方法，这里需要自己指写地址，
还有一种方法就是anotes.CURRENTDATABASE, 用这种方法要注意一点，不能有其他的邮件数据库打开并激活，否则找到的就是这个另外打开的数据库，

1. Sub aaa()
   
2. 
   
3.     Dim anotes
   
4.     Dim aDataBase
   
5.     Dim aview
   
6.     Dim itotal
   
7.     Dim adocument
   
8.     Dim ws
   
9.     Dim notesdoc
   
10.     Dim field
    
11.     Dim att As Variant
    
12.     Dim x As Integer
    
13.    
    
14.     att = Application.GetOpenFilename(filefilter:="All file,*.*", MultiSelect:=True)
    
15.    
    
16.     Set ws = CreateObject("Notes.NotesUIWorkspace")
    
17. 
    
18.     Set anotes = CreateObject("Notes.NotesSession")
    
19. 
    
20.     Set aDataBase = anotes.GETDATABASE("", "C:\notes\data\mail3\tonyhf.nsf")
    
21. 
    
22.     Set notesdoc = aDataBase.CREATEDOCUMENT
    
23.     Set field = notesdoc.CREATERICHTEXTITEM("body")
    
24.    
    
25.     For x = 1 To UBound(att)
    
26.    
    
27.         field.embedobject 1454, "", att(x)
    
28.         
    
29.     Next x
    
30.    
    
31.     Set uidoc = ws.EDITDOCUMENT(True, notesdoc)
    
32. 
    
33. End Sub

复制代码

yucan20018

tonyibm 发表于 2012-11-25 21:34
注意这一句：
Set aDataBase = anotes.GETDATABASE("", "C:\notes\data\mail3\tonyhf.nsf")
我这里是用的 ...

非常感谢，验证了，确实达到了预期的效果。现在还有2个邮件外观美化的需求，请帮忙看下可不可以实现。

1、以上代码插入的附件是直接在邮件最后面的，但我的邮件是带有签名的，可不可以让附件加在签名之前；
2、以上代码插入的附件，是灰色的，可不可以将插入的附件显示为我附件需求的那种形式（文件的图标加文件明）。

谢谢！

tonyibm

第二个问题，看一下这篇文章

http://www.vbafan.com/2012/07/14/method-to-show-correct-application-icon-in-lotus-notes-by-vba/

第一个问题，

没有找到好的解决方案，只有将签名先去除，然后在代码中再添加，

tonyibm

对于你的第二个问题，我偶然发现下面的方式可以解决，只不过这样会让附件出现在邮件正文上面的灰色区域，


[code=vb]Sub test()
    Dim anotes
    Dim aDataBase
    Dim ws As Object
    Dim notesdoc
    Dim field
    Dim att As Variant
    Dim x As Integer
    Dim uidoc As Object
   
att = Application.GetOpenFilename(filefilter:="All file,*.*", MultiSelect:=True)

    Set ws = CreateObject("Notes.NotesUIWorkspace")

    Set anotes = CreateObject("Notes.NotesSession")

    Set aDataBase = anotes.GETDATABASE("", "C:\notes\data\mail3\tonyhf.nsf")

    Set notesdoc = aDataBase.CREATEDOCUMENT
   
    Set uidoc = ws.CURRENTDOCUMENT()
   
Set field = notesdoc.CREATERICHTEXTITEM("body1")

For x = 1 To UBound(att)

        field.embedobject 1454, "", att(x)

Next x

    Set uidoc = ws.EDITDOCUMENT(True, notesdoc)

End Sub

[/code]

起作用的代码是：

Set field = notesdoc.CREATERICHTEXTITEM("body1"), 注意这里不是body, 而是body1,

keejo

tonyibm 发表于 2012-11-25 21:34
注意这一句：
Set aDataBase = anotes.GETDATABASE("", "C:\notes\data\mail3\tonyhf.nsf")
我这里是用的 ...

您好，我采用 aotes.CURRENTDATABASE 这种方式连接数据库，保证邮件数据库已打开激活，直接在vba里运行是生效的。于是我在
Private Sub Workbook_Open()

End Sub
里直接调用这个sub，并在发送邮件这个sub里增加了Applicaiton.Quit
然后用windows server的计划任务定时打开这个excel文档，已达到定时发送邮件的效果，测试失败，计划任务显示已完成（0X1），应该是哪里才出了问题。正常执行的任务为已完成（0X0）
求大神破解，万分感谢

Jocky

求教类似问题：如果我已经设置好一个以"Template"命名的信纸时，如何每次发邮件的时候都可以直接调用该信纸？