Outlook 2010 VBA任務附件

Outlook 2010 VBA，我想在發送電子郵件時創建一個任務，但是我想從電子郵件中添加所有附件的任務，代碼工作正常但不添加附件，我嘗試使用.Attachments.Add（不支持），.Attachments = item.Attachments return propierty是隻讀的Outlook 2010 VBA任務附件

它有可能嗎？或者我如何將漏洞郵件附加到任務上？

THX

這裏是代碼

公共WITHEVENTS myOlApp作爲Outlook.Application

私人小組Application_MAPILogonComplete（）

末次

私人小組Application_Startup（） Initialize_handler End Sub

公用Sub Initialize_handler（）集myOlApp =的CreateObject（「Outlook.Application」）結束子

私人小組myOlApp_ItemSend（BYVAL項目作爲對象，取消由於布爾）

昏暗intRes作爲整數暗淡strMsg作爲字符串昏暗objTask作爲TaskItem 集objTask = Application.CreateItem（olTaskItem）昏暗strRecip作爲字符串昏暗ATT作爲的MailItem 昏暗objMail作爲Outlook.MailItem

strMsg =「你想爲這封郵件創建一個任務嗎？」 intRes = MSGBOX（strMsg，vbYesNo + vbExclamation，「創建任務」）

If intRes = vbNo Then 
    Cancel = False 
Else 

For Each Recipient In item.Recipients 
    strRecip = strRecip & vbCrLf & Recipient.Address 
Next Recipient 



With objTask 
    '.Body = strRecip & vbCrLf & Item.Body 
    .Body = item.Body 
    .Subject = item.Subject 
    .StartDate = item.ReceivedTime 
    .ReminderSet = True 
    .ReminderTime = DateSerial(Year(Now), Month(Now), Day(Now + 1)) + #8:00:00 AM# 
    **.Attachments.Add (item.Attachments)** 
    .Save 
End With 

Cancel = False 

End If

集objTask =無

結束子

來源

2013-02-25 Hams

下面是最終代碼的工作，如果有人需要它 – Hams 2013-02-25 21:45:51

Attachments.Add允許通過一個字符串作爲參數（完全queslified附件文件名）或Outlook項目（如MailItem）。你正在傳遞Attachments集合作爲參數，你不能那樣做。

對於每個附件，先保存附件（Attachment.SaveAsFile），然後將它們添加到任務中，一次傳遞文件名作爲參數。

來源

2013-02-25 17:09:01

謝謝您的幫助 – Hams 2013-02-25 21:46:55

這是我最後的代碼

Public WithEvents myOlApp As Outlook.Application 

Private Sub Application_MAPILogonComplete() 

End Sub 

Private Sub Application_Startup() 
Initialize_handler 
End Sub 

Public Sub Initialize_handler() 
Set myOlApp = CreateObject("Outlook.Application") 
End Sub 

Private Sub myOlApp_ItemSend(ByVal item As Object, Cancel As Boolean) 

Dim intRes As Integer 
Dim strMsg As String 
Dim objTask As TaskItem 
Set objTask = Application.CreateItem(olTaskItem) 
Dim strRecip As String 
Dim att As MailItem 
Dim objMail As Outlook.MailItem 
Dim Msg As Variant 

strFolderPath = "C:\temp" ' path to target folder 


strMsg = "Do you want to create a task for this message?" 
intRes = MsgBox(strMsg, vbYesNo + vbExclamation, "Create Task") 


If intRes = vbNo Then 
    Cancel = False 
Else 

For Each Recipient In item.Recipients 
    strRecip = strRecip & vbCrLf & Recipient.Address 
Next Recipient 

item.SaveAs strFolderPath & "\" & "test" & ".msg", olMSG 

'item.Save 

With objTask 
    '.Body = strRecip & vbCrLf & Item.Body 
    .Body = item.Body 
    .Subject = item.Subject 
    .StartDate = item.ReceivedTime 
    .ReminderSet = True 
    .ReminderTime = DateSerial(Year(Now), Month(Now), Day(Now + 1)) + #8:00:00 AM# 
    .Attachments.Add item 
    .Save 
End With 

Cancel = False 

End If 

Set objTask = Nothing 

End Sub

來源

2013-02-26 14:57:41 Hams

Outlook 2010 VBA任務附件

回答

相關問題