需要正确的宏编码才能将文档 a/o 文件从 Excel 电子表格附加到 Outlook



我有一个宏,用于搜索联系人列表,该联系人列表从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 对象)。

相关内容

  • 没有找到相关文章

最新更新