2023-11-23 04:50:50
用条件判断就行了
发邮件核心函数用这个
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 |
Sub emailTo(ByVal toEmail As String, Optional ByVal toCC As String, Optional ByVal toBCC As String, Optional 哗段ByVal toSubject As String, Optional ByVal toBody As String, Optional ByVal attach As String, Optional ByVal doPaste As Boolean = False) '支持群发邮件 (相同主题、正文) _ Email地址用:隔开 支持直接使用姓名、通讯组列表名 _ 附件路径用:隔伏芦码开 With Application '.EnableEvents = False '.ScreenUpdating = False End 缺哪With Dim myOL As New Outlook.Application, myMail As MailItem, myNamespace As Namespace, myDistList As DistListItem, myFolder As Folder, emailAry(2), ccAry, bccAry, attachAry, tmpStr As String Set myOL = New Outlook.Application Set myNamespace = myOL.GetNamespace("MAPI") Set myFolder = myNamespace.GetDefaultFolder(olFolderContacts) 'myFolder.display emailAry(0) = toEmail emailAry(1) = toCC emailAry(2) = toBCC attachAry = Split(attach, ";") Set myMail = myOL.CreateItem(olMailItem) With myMail .To = toEmail .cc = toCC .BCC = toBCC .Subject = toSubject .BodyFormat = olFormatHTML .HTMLBody = '批量发送邮件VBA by zzllrr iMacro V1.0' '.body = toBody If UBound(attachAry) > -1 Then For Each att In attachAry .Attachments.Add att Next att End If 'Application.ActivateMicrosoftApp xlMicrosoftMail .display 'myOL.ActiveExplorer 'AppActivate myMail SendKeys "{TAB}" '从subject切换到正文 If doPaste Then Application.Wait Now + TimeValue("00:00:04") SendKeys "{END}" SendKeys "^v" 'SendKeys "~" End If Application.Wait Now + TimeValue("00:00:02") ' .Save ' .Close olSave '.send End With Set myMail = Nothing Set myOL = Nothing End Sub
2024-04-09 22:14:13
2022-07-02 01:40:11