我有一个宏,用于搜索联系人列表,该联系人列表从Excel中的联系人列表中提取数据,并准备要在Outlook中发送的电子邮件。
此宏的大部分都能成功运行。 我快完成了。
我还需要它来搜索文件夹(使用要在单元格 A8 中输入的文件名)并将适当的文件附加到电子邮件中。
(文件夹路径:C:\Users\SERGIL\Desktop\VATS )
Below is the code I have thus far:
Public Sub SendEmails()
Const cSUBJECT As String = "C2"
Const cBODY As String = "C3"
Const cSTART_ROW_INDEX As String = "C4"
Const cEND_ROW_INDEX As String = "C5"
Const cMAIL_TO_COLUMN As String = "G" ' The column with the email addresses in it
Const cCOMPANY_NAME_COLUMN As String = "B" ' The column with the Vendor/Company Names in it
'Put as many email addresses here as you want, just seperate them with a semicolon
Const cCC_EMAIL_ADDRESSES As String = "C6"
Const cFROM_ADDRESS As String = "C7"
Dim iRowCount As Integer
Dim iEndRow As Integer
'Grab the current open worksheet object
Dim oSheet As Worksheet
Set oSheet = ActiveSheet
iRowCount = oSheet.Range(cSTART_ROW_INDEX).Value2 ' Get the Start Value
iEndRow = oSheet.Range(cEND_ROW_INDEX).Value2 ' Get the End Value
Dim dBatchStart As Date
Dim dBatchEnd As Date
Dim sVendorName As String
Dim sEmail As String
Dim sSubject As String
Dim sBody As String
'Outlook must already be open, attach to the open instance
Dim oOutlook As Outlook.Application
Set oOutlook = GetObject(, "Outlook.Application")
'Declare a new draft email object
Dim oMail As Outlook.MailItem
'Start iterating through all the rows of mail, creating a new draft each loop
Do Until iRowCount = (iEndRow + 1)
'Actually instantiate the new draft email object
Set oMail = oOutlook.CreateItem(olMailItem)
'Display the draft on screen to the user can see and validate it
oMail.Display
'Set the TO address based on the data in the sheet
oMail.To = oSheet.Range(cMAIL_TO_COLUMN & iRowCount).Value2
'Get the subject, also, substitute the tags for Company and Start Date with the values in the sheet
sSubject = oSheet.Range(cSUBJECT).Value2
sSubject = Replace(sSubject, "<DATE FOR THAT VENDOR GROUP>", Format(dBatchStart, "Long Date"))
sSubject = Replace(sSubject, "<COMPANY>", oSheet.Range(cCOMPANY_NAME_COLUMN & iRowCount).Value2)
'Now insert the formatted subject into the draft email
oMail.Subject = sSubject
'Get the Body, substitute the tags for Start Date and End Date with the values in the sheet
sBody = oSheet.Range(cBODY).Value2
'Now insert the formatted Body into the draft email
oMail.HTMLBody = sBody
'Now add attachments
oMail.HTMLBody = sBody
'Set the CC address based on the Constant at the top
oMail.CC = oSheet.Range(cCC_EMAIL_ADDRESSES).Value2
oMail.Save
'Set the actual sender of the name. It won't display for the user, but will actually sent as that address
oMail.SentOnBehalfOfName = oSheet.Range(cFROM_ADDRESS).Value2
oMail.Save
'The draft mail item is now complete.
'The from address will need to be changed manually.
'The user will need to actually send the email once reviewed.
iRowCount = iRowCount + 1
Loop
With objMail
.Attachments.Add rngAttach.Value
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
End With
End Sub
-- 我收到这段代码的错误:
With objMail
.Attachments.Add rngAttach.Value
.Display 'Instead of .Display, you can use .Send to send the email _
or .Save to save a copy in the drafts folder
Attachments 类的 Add 方法接受四个参数。Source 参数(第一个)应为文件(由带有文件名的完整文件系统路径表示)或构成附件的 Outlook 项目。
似乎您需要将 rngAttach.Value 语句替换为有效参数(文件或 Outlook 对象)。