Code Script .co.uk

Home | Scripts | Tutorials | Disclaimer | Sitemap | Contact

   Create Email With Past Date
 

Vbscript / Ms Office / Create Email With Past Date

Script to create email with specified subject, to address, from address, body, attachment and sent date.


Const PR_EMAIL = &H39FE001E

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = WScript.CreateObject("WScript.Shell")

scriptPath = objFSO.GetParentFolderName(WScript.ScriptFullName) & "\"
filePath = scriptPath & "test.jpg"
docPath = scriptPath & "test.doc"

mapiInit

createEmail "Current", smtp, smtp, "Hello", filePath, Now
createEmail "6 Months Old", smtp, smtp, "Hello", filePath, DateAdd("m",-6,Now)
createEmail "15 Months Old", smtp, smtp, "Hello", docPath, DateAdd("m",-15,Now)

objMAPI.Logoff

Wscript.Echo "Done"


Sub mapiInit
 Set objMAPI = CreateObject("MAPI.Session")
 profile = ""
 On Error Resume Next
 profile = objShell.RegRead("HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\DefaultProfile")
 On Error Goto 0

 If Len(profile) = 0 Then
  objMAPI.Logon profile
 Else
  ' prompt user for profile
  objMAPI.Logon
 End If
 
 Set objAddress = objMAPI.CurrentUser
 smtp = objMAPI.GetAddressEntry(objAddress.ID).Fields(PR_EMAIL)
End Sub

Sub createEmail(subject, sendTo, sentFrom, body, attachment, sendDate)
 
 Set objMsg = objMAPI.Outbox.Messages.Add
 objMsg.Subject = subject
 objMsg.Text = body
 
 Set objRecip = objMsg.Recipients.Add
 objRecip.Name = sendTo
 objRecip.Type = 1
 objRecip.Resolve
 
 Set objRecip = objMsg.Recipients.Add
 objRecip.Name = sentFrom
 objRecip.Type = 1
 objRecip.Resolve
 objMsg.Sender = objRecip.AddressEntry
 objRecip.Delete
 
 objMsg.TimeSent = sendDate
 objMsg.TimeReceived = sendDate
 
 objMsg.Sent = True
 objMsg.Submitted = True
 objMsg.Unread = False
 
 If Len(attachment) > 0 Then
  Set objAttach = objMsg.Attachments.Add()
  objAttach.Position = -1
  objAttach.Name = attachment
  objAttach.ReadFromFile(attachment)
 End If
 
 objMsg.Update
 
 'Move to inbox
 objMsg.MoveTo(objMAPI.GetDefaultFolder(1).ID)
 

 objAttach = Nothing
 objRecip = Nothing
 objMsg = Nothing
End Sub





Please note that a disclaimer applies to any code on this page.
 
   Actions
  Go Back
  Bookmark
  Print Page


   Menu
 
- Links
- Reference
- Script Editors
- Tutorials
- Vbscript
     - Active Directory
     - Exchange
     - Files And Folders
     - General
     - Ms Office
          - Create Email In Mailbox
          - Create Email With Past Date
          - Create Mailbox Folders In Pst File
          - Find Acronyms In Word Document
          - Outlook Autocomplete Import
          - Read Data From Spreadsheet
          - Read Word Document
          - Word Edit User Properties
          - Word File Save Location
          - Word Hide Toolbar
          - Word Template Location
     - Operating System
     - Processes And Services
     - Text Processing
     - User Interaction
     - Web Servers