vb outlook发邮件

Posted 2023-02-02 fighting18

Function SendEmail(ByVal sMail, ByVal sSubject, ByVal sBody, ByVal sCC)

Dim objOutlook As New Outlook.Application
   '定义outlook邮件的对象变量
   Dim objMail As MailItem
Dim strTo As Variant
Dim sptTo() As String
   '创建objOutlook为Outlook应用程序对象
   Set objOutlook = New Outlook.Application
   '创建objMail为一个邮件对象
   Set objMail = objOutlook.CreateItem(olMailItem)
   
   sptTo = Split(sMail, ";")

    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    End With

    With objMail
        .Subject = sSubject
        
        .htmlBody = sBody
                
        For Each strTo In sptTo()
            If Len(Trim(strTo)) <> 0 Then
                .Recipients.Add strTo
                
            End If
        Next
         .CC = sCC
    
        .Display
    End With

    With Application
    .EnableEvents = True
    .ScreenUpdating = True
    End With
End Function

Sub send email()
Dim wb_Marco As Workbook

Dim wsh2 As Worksheet

Dim strMail As Variant, strSubject As String
Dim strBody As String, strOutlook As String
Dim strCC As Variant
Application.ScreenUpdating = False

Set wb_Marco = ThisWorkbook
 

'发送邮件
'Set wsh2 = wb_Marco.Worksheets("Email ")
'    With ActiveSheet
'        strMail = wsh2.Range("B4").Value
'        strSubject = wsh2.Range("B2").Value
'        strBody = wsh2.Range("B3").Value
'    End With
'    SendEmail strMail, strSubject, strBody
'    MsgBox "发送邮件完毕！", vbInformation + vbOKOnly, "提示"

'wb_Source.Close 关闭excel

End Sub