Solved

Email activation failed.

Posted on 2010-08-25
22
453 Views
Last Modified: 2012-05-10
Hi Experts,

I would like to request Experts Help. For some reason the attached script not activate outlook email even though I’ve the Outlook reference is active. Hope Experts can help me to rectify this problem. I’ve attached the workbook for your reference.


Sub SendEmail()
  'Uses early binding
  'Requires a reference to the Outlook Object Library
  Dim OutlookApp As Outlook.Application
  Dim MItem As Outlook.MailItem
  Dim olAppointment As Outlook.AppointmentItem
  
  Dim cell As Range
  Dim Subj As String
  Dim EmailAddr As String
  Dim Adate As Date
  Dim Atime As String
  Dim Msg2 As String
  Dim SendStatus As String
  
      
  'Create Outlook object
  Set OutlookApp = New Outlook.Application
  
  'Loop through the rows
  For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "*@*" Then
    
      'Get the data
      SendStatus = cell.Offset(0, 1)
      If SendStatus <> "To be sent" Then GoTo NotThisOne
      Subj = cell.Offset(0, -1).Value
      EmailAddr = cell.Value
      Adate = cell.Offset(0, -6).Value
      Atime = cell.Offset(0, -5).Value
      FileLocation = "C:\ApptFiles\OutlookAppointment.ics"
      cell.Offset(0, 1).Value = "Sent"

      
    Dim olApp As Outlook.Application
    Dim olApt As AppointmentItem
    
    Set olApp = New Outlook.Application
    Set olApt = olApp.CreateItem(olAppointmentItem)
    Msg2 = "New Task"
    
    With olApt
        .Start = Adate
        .End = .Start + TimeValue("00:30:00")
        .Subject = Msg2
        .Location = " "
        .Body = Msg
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 2880
        .ReminderSet = True
        '.Display
        
        'Save the iCalendar file in a known folder
        .SaveAs "C:\ApptFiles\OutlookAppointment.ics", olICal
        
        'Use Close to retain the new appointment within the Outlook Calendar, or Delete to delete it.
        'Both options keep the just-created .ics file
        
        '.Close False
        .Delete
    
    End With

      Set MItem = OutlookApp.CreateItem(olMailItem)
      With MItem
        .To = EmailAddr
        .Subject = Subj
        .Body = Msg
        .Attachments.Add (FileLocation)
        .Send
        '.Save 'to Drafts folder
      End With
NotThisOne:
    End If
  Next
  Set OutlookApp = Nothing
  Set olApt = Nothing
  Set olApp = Nothing

End Sub

Open in new window

EvenList.xls
0
Comment
Question by:Theva
  • 11
  • 11
22 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33528216
First off it is a tad confusing ... are you sure you want two references to outlook and an outlook item:

  Set OutlookApp = New Outlook.Application

    Set olApp = New Outlook.Application
    Set olApt = olApp.CreateItem(olAppointmentItem)
 
      Set MItem = OutlookApp.CreateItem(olMailItem)

Irrespective can you say why "attached script not activate outlook email "

Chris
0
 

Author Comment

by:Theva
ID: 33528417
Hi Chris,

I need to activate Outlook references, if not it shows error at this line:

 "OutlookApp As Outlook.Application"

The objective of having this script is to send calendar to recipient. Initially it works but I'm not what when its no longer works.  
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33528508
I  have tried to 'tidy' it up in the hope it helps ... and moved it to late binding.

Chris
Sub SendEmail()
Dim olkApp As Object
Dim MItem As Object
Dim olkAppointment As Object
  
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Adate As Date
Dim Atime As String
Dim Msg As String
Dim Msg2 As String
Dim SendStatus As String
Dim FileLocation As String

Const olAppointmentItem As Integer = 1
Const olBusy As Integer = 2
Const olICal As Integer = 8
Const olMailItem As Integer = 0
      
  'Loop through the rows
  For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "*@*" Then
    
      'Get the data
      SendStatus = cell.Offset(0, 1)
      If SendStatus <> "To be sent" Then GoTo NotThisOne
      Subj = cell.Offset(0, -1).Value
      EmailAddr = cell.Value
      Adate = cell.Offset(0, -6).Value
      Atime = cell.Offset(0, -5).Value
      FileLocation = "C:\ApptFiles\OutlookAppointment.ics"
      cell.Offset(0, 1).Value = "Sent"
   
    Set olkApp = CreateObject("outlook.application")
    Set olkAppointment = olkApp.CreateItem(olAppointmentItem)
    Msg2 = "New Task"
    
    With olkAppointment
        .Start = Adate
        .End = .Start + TimeValue("00:30:00")
        .subject = Msg2
        .Location = " "
        .body = Msg
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 2880
        .ReminderSet = True
        '.Display
        
        'Save the iCalendar file in a known folder
        .SaveAs FileLocation, olICal
        
        'Use Close to retain the new appointment within the Outlook Calendar, or Delete to delete it.
        'Both options keep the just-created .ics file
        
        '.Close False
        .Delete
    
    End With

      Set MItem = olkApp.CreateItem(olMailItem)
      With MItem
        .To = EmailAddr
        .subject = Subj
        .body = Msg
        .Attachments.Add (FileLocation)
        .Send
        '.Save 'to Drafts folder
      End With
NotThisOne:
    End If
  Next
  Set olkApp = Nothing
  Set olkAppointment = Nothing
  Set olkApp = Nothing

End Sub

Open in new window

0
Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

 

Author Comment

by:Theva
ID: 33528601
Hi,

Tried, when I click the command button its not responding at all.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33528684
I tried it before posting and as soon as I changed a couple of cells in column I it worked!

Chris
0
 

Author Comment

by:Theva
ID: 33529795
Hi,

I've no idea why its not working in my PC. I've reused the original version that was used before introducing Column_I (email status). It works perfectly. I have attached the workbook and the script is in Module1. The module 2 is belongs to your refine version. Hope you can help me figure out what when wrong in Module2.



 
1EventList.xls
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33529887
Send status isn't there any more.  The code in module executes if there is an email in H whereas in module 2 it executes if there is an email in H ***AND***
the cell in column I is "To be sent"

I is blank therefore no mails will result.

Chris
0
 

Author Comment

by:Theva
ID: 33534558
Hi Chris,

Thanks for the help. I need one more help. Is that possible when I send the email the event will be registered in my Outlook Calendar as well?  Hope you will
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33534905
What / how do you want of the 'event' in the calendar?

Chris
0
 

Author Comment

by:Theva
ID: 33534991
Hi,

Sorry if this request confusing you. What I need is to automatically update my Outlook Calendar based on information from Column B,C and G once click the Button "Email Send".
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33535360
One entry for all the rows? one entry per row.

No alarms or anything?

Chris
0
 

Author Comment

by:Theva
ID: 33536643
Hi Chris

One entry, which ever rows under status "To be Send" at Column_I will be automatically updated in Calender with Alarm (5mins before event).
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33539150
Can you supply version of sheet and code is now working after all the last file did not have column I populated but teh code was checking it so before I try and add the code I would like a representative file to work with.

C hris
0
 

Author Comment

by:Theva
ID: 33539281
Hi Chris,

Here's the file for your perusal.
EventList-2-.xls
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 33539842
HAve set the appointment for 7 days after run time and other defaults as I see fit - all can of course be changed.

Chris
Sub SendEmail()
Dim olkApp As Object
Dim MItem As Object
Dim olkAppointment As Object
  
Dim cell As Range
Dim Subj As String
Dim EmailAddr As String
Dim Adate As Date
Dim Atime As String
Dim Msg As String
Dim Msg2 As String
Dim SendStatus As String
Dim FileLocation As String
Dim strApptBody As String

Const olAppointmentItem As Integer = 1
Const olBusy As Integer = 2
Const olICal As Integer = 8
Const olMailItem As Integer = 0
      
  'Loop through the rows
  For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value Like "*@*" Then
    
      'Get the data
      SendStatus = cell.Offset(0, 1)
      If SendStatus <> "To be sent" Then GoTo NotThisOne
      Subj = cell.Offset(0, -1).Value
      EmailAddr = cell.Value
      Adate = cell.Offset(0, -6).Value
      Atime = cell.Offset(0, -5).Value
      FileLocation = "C:\ApptFiles\OutlookAppointment.ics"
'FileLocation = Environ("temp") & "\" & "OutlookAppointment.ics"
    cell.Offset(0, 1).Value = "Sent"
   
    Set olkApp = CreateObject("outlook.application")
    Set olkAppointment = olkApp.CreateItem(olAppointmentItem)
    Msg2 = "New Task"
    
    With olkAppointment
        .Start = Adate
        .End = .Start + TimeValue("00:30:00")
        .Subject = Msg2
        .Location = " "
        .Body = Msg
        .BusyStatus = olBusy
        .ReminderMinutesBeforeStart = 2880
        .ReminderSet = True
        '.Display
        
        'Save the iCalendar file in a known folder
        .SaveAs FileLocation, olICal
        
        'Use Close to retain the new appointment within the Outlook Calendar, or Delete to delete it.
        'Both options keep the just-created .ics file
        
        '.Close False
        .Delete
    
    End With

      Set MItem = olkApp.CreateItem(olMailItem)
      With MItem
        .To = EmailAddr
        .Subject = Subj
        .Body = Msg
        .Attachments.Add (FileLocation)
        .Send
        '.Save 'to Drafts folder
      End With
      strApptBody = strApptBody & "Item: " & Format(cell.Offset(0, -6).Value + cell.Offset(0, -5).Value, "dd mmm yyyy hh:mm") & " | " & cell.Offset(0, -1).Value & vbCrLf
NotThisOne:
    End If
  Next
  If strApptBody <> "" Then
        With olkApp.CreateItem(olAppointmentItem)
            .Start = DateAdd("d", 7, Now())
            .End = .Start + TimeValue("00:30:00")
            .Subject = "Event Record"
            .Location = " "
            .Body = strApptBody
            .BusyStatus = olBusy
            .ReminderMinutesBeforeStart = 2880
            .ReminderSet = True
            .Save
            .Close False
    End With
  End If
  Set olkApp = Nothing
  Set olkAppointment = Nothing
  Set olkApp = Nothing

End Sub

Open in new window

0
 

Author Comment

by:Theva
ID: 33545374
Hi Chris,

Thanks for the code. When I sent the email, received pop-up massage at Taskbar "Cannot save free/busy information" How to rectify this?
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33545605
I have no idea, a quick trawl around suggests it affects a lot of people ... but in this case I doubt it needs to be a 'busy' appt so try commenting out:

            .BusyStatus = olBusy
ie.
            '.BusyStatus = olBusy

Chris
0
 

Author Comment

by:Theva
ID: 33545706
Hi Chris,

I've commented out line 47 and 83, yet showing the same result.  
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33545853
Hmmm, like I said there's a lot about it and I couldn't see anything conclusive so try the cleanfreebusy switch:

http://www.howto-outlook.com/howto/commandlineswitches.htm

Chris
0
 

Author Comment

by:Theva
ID: 33547990
Hi Chris,

I've checked the web page, not sure how to fix this bug.
0
 

Author Closing Comment

by:Theva
ID: 33547994
Hi Chris,

Thanks a lot for helping me to create this script.
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 33548350
Basically restart outlook from the command line using the cleanfreebusy switch
0

Featured Post

What is SQL Server and how does it work?

The purpose of this paper is to provide you background on SQL Server. It’s your self-study guide for learning fundamentals. It includes both the history of SQL and its technical basics. Concepts and definitions will form the solid foundation of your future DBA expertise.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Are you unable to connect or configure Hotmail email account in Microsoft Outlook 2010, 2007? Or Outlook.com emails are not downloading to Outlook? Lets’ see the problem and resolve Outlook Connector error syncing folder hierarchy (0x8004102A).
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

831 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question