用excel通过lotus notes自动发送邮件，如何能发送给多位copy to

catstory

各位大虾，

我有一个以前高手留下的excel VBA文件，可以自由选择文件夹路径，添加附件，选择需要发送的email address,copy to 的email address.平时用的都很好。唯一的遗憾是目前在 copy to的column里面只能放一个地址，如果放两个，即使中间用了;分割，也只有第一个人可以收到。

能用数组的方式吗？

如何更改？

Copy of Send mails to suppliers V2.1.zip (36.09 KB, 下载次数: 446)

2011-8-19 10:47 上传

点击文件名下载附件

catstory

Sub Send_Mail()

Dim Recipient(100) As Variant
Dim CopyToRecipient(100) As Variant
Dim Attachment(100) As Variant
Dim Subject(100) As Variant
Dim BodyText(100) As Variant
Dim recipient_address As String

Dim SaveIt As Boolean

column_signature = 6
row_signature = 2

ligne_standard_message = 2
column_standard_message = 7

column_standard_subject = 5
row_standard_subject = 2

column_supplier = 1
column_to = 2
column_key_contact = 3
column_copy_to = 4
column_file_name = 5
column_subject = 6
column_body_text = 7
column_check = 8
column_path = 9

'On désactive la maj de l'écran, les messages d'alertes et les macro evenementielles
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

SaveIt = True
Sheets("datas").Activate
n = 1
Do While Not IsEmpty(Cells(n, column_file_name))
n = n + 1
Loop
n = n - 1

index_mail = -1
        'Recipient
        For i = 2 To n
          If Cells(i, column_to).Text <> "" And Cells(i, column_key_contact).Text <> "" Then
          index_mail = index_mail + 1
          Recipient(index_mail) = Cells(i, column_to).Text
          Cells(i, column_check).Value = "ok"
          mails_to_send = mails_to_send + 1
          Else
          Cells(i, column_check).Value = "not ok"
          End If
        Next
        
  last_index = index_mail
        
        'Copy to
        index_mail = 0
        For i = 2 To n
          If Cells(i, column_check).Value = "ok" Then
          CopyToRecipient(index_mail) = Cells(i, column_copy_to).Text
          index_mail = index_mail + 1
          End If
        Next
  
        Dim Maildb As Object 'The mail database
        Dim UserName As String 'The current users notes name
        Dim MailDbName As String 'THe current users notes mail databasename
        Dim MailDoc As Object 'The mail document itself
        Dim AttachME As Object 'The attachment richtextfile object
        Dim Session As Object 'The notes session
        Dim EmbedObj As Object 'The embedded object (Attachment)
        
        'Body of the message
        index_mail = 0
        For i = 2 To n
          If Cells(i, column_check).Value = "ok" Then
          BodyText(index_mail) = Cells(i, column_body_text).Text
          index_mail = index_mail + 1
          End If
        Next
        
        
        'Subject
        index_mail = 0
        For i = 2 To n
          If Cells(i, column_check).Value = "ok" Then
          Subject(index_mail) = Cells(i, column_subject).Text
          index_mail = index_mail + 1
          End If
        Next
        
        'Attachment
        index_mail = 0
        For i = 2 To n
          If Cells(i, column_check).Value = "ok" Then
          Attachment(index_mail) = Cells(i, column_path).Text
          index_mail = index_mail + 1
          End If
        Next
    For index_mail = 0 To last_index
    recipient_address = Recipient(index_mail)
    copy_to_address = CopyToRecipient(index_mail)
        'Start a session to notes
        Set Session = CreateObject("Notes.NotesSession")
        
        'Get the sessions username and then calculate the mail file name
        'You may or may not need this as for MailDBname with some systems you
        'can pass an empty string
        UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
        'Open the mail database in notes
        Set Maildb = Session.GETDATABASE("", MailDbName)
         If Maildb.IsOpen = True Then
                    'Already open for mail
         Else
                 Maildb.OPENMAIL
         End If
   
        'Set up the new mail document
        Set MailDoc = Maildb.CREATEDOCUMENT
        MailDoc.Form = "Memo"
        MailDoc.sendto = recipient_address
        MailDoc.copyto = copy_to_address
        MailDoc.Subject = Subject(index_mail)
        MailDoc.body = BodyText(index_mail)
        'MailDoc.ReturnReceipt = "1"
        
        MailDoc.SAVEMESSAGEONSEND = SaveIt

        'Les trois attachement sont les noms et chemins des fichiers à envoyer
        If Attachment(index_mail) <> "" Then
                Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment(" & index_mail & " )")
                Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment(index_mail), "Attachment(" & index_mail & " )")
                'MailDoc.CREATERICHTEXTITEM ("Attachment(" & i & " )")
        End If
        

         'Send the document
         MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
         MailDoc.SEND 0, recipient_address
         
         
        'Clean Up
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set AttachME = Nothing
        Set Session = Nothing
        Set EmbedObj = Nothing
    Next
        
    Sheets("Datas").Select
    Cells.Select
    Selection.RowHeight = 15
    Cells.Select
    Cells.EntireColumn.AutoFit

'Reactivation des messages d'alerte et des macros evenementielles
Application.EnableEvents = True
Application.DisplayAlerts = True

        
End Sub

把这段copy出来方便大家看，我个人觉得问是 “copy to"的那里能不能用数组的方式得到多个值，可是不知道具体怎么做？

liucqa

catstory 发表于 2011-8-19 11:50
Sub Send_Mail()

Dim Recipient(100) As Variant

copy_to_address

用逗号将地址分割，放到这个串里面不行吗？

xiaoying_lily

好复杂，关注学习中

goldowl2011

Mark it . Thanks you for your codes.

XIAOXIAOLI

太复杂了，

xiaolongx

Mark it                                      

lyh512250428

怎么 发送前弹出mail  窗体 二次确认？

tonyibm

这样就可以了，

vaRecipient = VBA.Array("邮件1", "邮件2")

tonyibm

lyh512250428 发表于 2014-7-8 19:14
怎么 发送前弹出mail  窗体 二次确认？

在send之前自己用msgbox写一段控制代码就是了，