2015-01-09 51 views
1

我有一個宏搜索聯繫人列表,從Excel中的聯繫人列表中提取數據,並準備在Outlook中發送的電子郵件。需要正確的宏編碼從Excel電子表格附加到Outlook的文檔a/o文件

這個宏的大部分工作成功。我差不多完成了。

我也需要它來搜索一個文件夾(使用在單元格A8中輸入的文件名)並將適當的文件附加到電子郵件中。

(文件夾路徑:C:\用戶\ SERGIL \桌面\ 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 

回答

1

Add方法附件類接受四個參數。 Source參數(第一個參數)應該是一個文件(由具有文件名的完整文件系統路徑表示)或構成附件的Outlook項目。

看來你需要用有效的參數(文件或Outlook對象)替換rngAttach.Value語句。

+0

非常感謝。我實際上在幫助另一方或試圖)。我不會假裝知道正確的方法來應用這個,但我相信這會有所幫助。 – user3509034 2015-01-09 19:23:11

相關問題