Mollethewizard
IS-IT--Management
I’ve searched the web and found the following code to send a draft and the code works fine. But with one exception – the draft is sent and removed from the drafts folder. Is it possible to modify the code so the draft is sent and kept for recycling? The content of the draft is sent several times per day and it would be nice to create a dialog box in a Word-document for the task. That bit I can manage.
The code so far:
Sub SendDraft()
Dim lDraftItem As Long
Dim myOutlook As Object
Dim myNameSpace As Object
Dim myFolders As Object
Dim myDraftsFolder As Object
Set myOutlook = CreateObject("Outlook.Application")
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
Const olFolderDrafts = 16
Set myDraftsFolder = myNameSpace.GetDefaultFolder(olFolderDrafts)
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
'Check for "To" address and only send if "To" is filled in.
'If Len(Trim(myDraftsFolder.Items.item(lDraftItem).To)) > 0 Then
If (myDraftsFolder.Items.item(lDraftItem).Subject) = "Rexlösenord_win7" Then
'myDraftsFolder.Items.item(lDraftItem).Send
myDraftsFolder.Items.item(lDraftItem).To = "NN@NN.se"
myDraftsFolder.Items.item(lDraftItem).Send
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
Greetings Christer
The code so far:
Sub SendDraft()
Dim lDraftItem As Long
Dim myOutlook As Object
Dim myNameSpace As Object
Dim myFolders As Object
Dim myDraftsFolder As Object
Set myOutlook = CreateObject("Outlook.Application")
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
Const olFolderDrafts = 16
Set myDraftsFolder = myNameSpace.GetDefaultFolder(olFolderDrafts)
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
'Check for "To" address and only send if "To" is filled in.
'If Len(Trim(myDraftsFolder.Items.item(lDraftItem).To)) > 0 Then
If (myDraftsFolder.Items.item(lDraftItem).Subject) = "Rexlösenord_win7" Then
'myDraftsFolder.Items.item(lDraftItem).Send
myDraftsFolder.Items.item(lDraftItem).To = "NN@NN.se"
myDraftsFolder.Items.item(lDraftItem).Send
End If
Next lDraftItem
'Clean-up
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
Greetings Christer