P
Pietro
Hi,
I need a code that does the following:
If Outlook is open, exit sub else open Outlook
Regards
I need a code that does the following:
If Outlook is open, exit sub else open Outlook
Regards
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
T
Tom van Stiphout
On Thu, 12 Mar 2009 03:07:02 -0700, Pietro
Standard automation code does that. Search for GetObject,
CreateObject.
-Tom.
Microsoft Access MVP
Standard automation code does that. Search for GetObject,
CreateObject.
-Tom.
Microsoft Access MVP
H
Hugh self taught
I use the CreateObject statement & get "Run-time error '287':
Application-defined or object-defined error. if an instance of Outlook is not
manually already running.
Any ideas on the cause of that? below is the code I'm using & I select case
3 while testing it out.
'The sub procedure below sends e-mail in response to a click on the Send
button.
Private Sub SendMessagesButton_Click()
'For Access, define some object variables and make connections.
Dim myConnection As ADODB.Connection
Set myConnection = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = myConnection
'Define some object variables for Outlook
Dim appOutlook As Outlook.Application 'Refers to Outlook's Application
object.
Dim appOutlookMsg As Outlook.MailItem 'Refers to an Outlook e-mail
message.
Dim appOutlookRecip As Outlook.Recipient 'Refers to an Outlook e-mail
recipient.
'General variables.
Dim mySQL As String, eMailAddress As String, whereClause As String
Dim countEm As Integer, myMsg As String
countEm = 0 'This will be used to keep track of the number of
messages sent.
'Start building the SQL statement for the recordset.
mySQL = "SELECT [Candidates].* FROM [Candidates]"
'Create search condition based on selected option button.
'SendOptions.Value refers to the option button selected near bottom of
form.
Select Case SendOptions.Value
Case 1 'New customers
whereClause = " WHERE Not [NewCustEmailSent] AND " & _
"([Candidates]. Is Not Null)"
Case 2 'All Customers
whereClause = " WHERE ([Candidates].[eMail] Is Not Null)"
Case 3
whereClause = " WHERE Candidates_Idx= " & Me![LookForID].Value
End Select
'Finish the SQL statement.
mySQL = mySQL & whereClause
'Now let's open up the recordset and start going through,
record-by-record.
myRecordSet.Open mySQL, , adOpenStatic, adLockOptimistic
'Bail out if recordset gets no records.
If myRecordSet.RecordCount < 1 Then
MsgBox ("There are no records that meet the criterion. No messages
sent.")
Exit Sub
End If
myRecordSet.MoveFirst
'Create an Outlook session in the background.
Set appOutlook = CreateObject("Outlook.Application")
Do Until myRecordSet.EOF 'For each record in myRecordset...
'Get the e-mail address from current record of myRecordset.
eMailAddress = myRecordSet.Fields("eMail")
'If there's a # character in the eMail address...
If InStr(1, eMailAddress, "#") > 0 Then
'...then chop off the # and everything that follows it.
eMailAddress = Left(eMailAddress, InStr(1, eMailAddress, "#") - 1)
End If
'Create a new, empty e-mail message.
Set appOutlookMsg = appOutlook.CreateItem(olMailItem)
With appOutlookMsg 'Using the new, empty message...
' Address the new message.
Set appOutlookRecip = .Recipients.Add(eMailAddress)
appOutlookRecip.Type = olTo 'Sets message to normal outgoing
e-mail message.
' Fill in the Subject line and main body of message.
.Subject = Me![Subject] 'Fill in the subject line.
.Body = Me![MessageBody] 'Fill in the message body.
'Add attachments, if any, to the e-mail message.
If Len(Me![Attachment]) > 0 Then
.Attachments.Add (Me![Attachment])
End If
.Send 'Send the completed message.
End With
myRecordSet.MoveNext 'Next record in recordset
countEm = countEm + 1 'Keeps track of number of messages printed for
later display.
Loop 'Repeat with next record, if not eof.
myRecordSet.Close 'All records processed when loop done. Close
recordset.
'If New Customers was selected, set NewCustEmailSent field to True.
If SendOptions.Value = 1 Then
DoCmd.SetWarnings False 'Temporarily hide warning messages.
'Update NewCustEmailSent to True.
'mySQL = "UPDATE [Address Book] SET [Address Book].NewCustEmailSent
= True " & _
' "WHERE [Address Book].NewCustEmailSent=False"
'DoCmd.RunSQL mySQL
DoCmd.SetWarnings True 'Unhide warning messages.
End If
'Display feedback message.
myMsg = countEm & " message(s) sent to Outlook's Outbox"
MsgBox (myMsg)
'All done when loop done. Clean up and say bye-bye.
Set myRecordSet = Nothing
Set appOutlookMsg = Nothing
Set appOutlook = Nothing
Set myConnection = Nothing
End Sub
Application-defined or object-defined error. if an instance of Outlook is not
manually already running.
Any ideas on the cause of that? below is the code I'm using & I select case
3 while testing it out.
'The sub procedure below sends e-mail in response to a click on the Send
button.
Private Sub SendMessagesButton_Click()
'For Access, define some object variables and make connections.
Dim myConnection As ADODB.Connection
Set myConnection = CurrentProject.Connection
Dim myRecordSet As New ADODB.Recordset
myRecordSet.ActiveConnection = myConnection
'Define some object variables for Outlook
Dim appOutlook As Outlook.Application 'Refers to Outlook's Application
object.
Dim appOutlookMsg As Outlook.MailItem 'Refers to an Outlook e-mail
message.
Dim appOutlookRecip As Outlook.Recipient 'Refers to an Outlook e-mail
recipient.
'General variables.
Dim mySQL As String, eMailAddress As String, whereClause As String
Dim countEm As Integer, myMsg As String
countEm = 0 'This will be used to keep track of the number of
messages sent.
'Start building the SQL statement for the recordset.
mySQL = "SELECT [Candidates].* FROM [Candidates]"
'Create search condition based on selected option button.
'SendOptions.Value refers to the option button selected near bottom of
form.
Select Case SendOptions.Value
Case 1 'New customers
whereClause = " WHERE Not [NewCustEmailSent] AND " & _
"([Candidates]. Is Not Null)"
Case 2 'All Customers
whereClause = " WHERE ([Candidates].[eMail] Is Not Null)"
Case 3
whereClause = " WHERE Candidates_Idx= " & Me![LookForID].Value
End Select
'Finish the SQL statement.
mySQL = mySQL & whereClause
'Now let's open up the recordset and start going through,
record-by-record.
myRecordSet.Open mySQL, , adOpenStatic, adLockOptimistic
'Bail out if recordset gets no records.
If myRecordSet.RecordCount < 1 Then
MsgBox ("There are no records that meet the criterion. No messages
sent.")
Exit Sub
End If
myRecordSet.MoveFirst
'Create an Outlook session in the background.
Set appOutlook = CreateObject("Outlook.Application")
Do Until myRecordSet.EOF 'For each record in myRecordset...
'Get the e-mail address from current record of myRecordset.
eMailAddress = myRecordSet.Fields("eMail")
'If there's a # character in the eMail address...
If InStr(1, eMailAddress, "#") > 0 Then
'...then chop off the # and everything that follows it.
eMailAddress = Left(eMailAddress, InStr(1, eMailAddress, "#") - 1)
End If
'Create a new, empty e-mail message.
Set appOutlookMsg = appOutlook.CreateItem(olMailItem)
With appOutlookMsg 'Using the new, empty message...
' Address the new message.
Set appOutlookRecip = .Recipients.Add(eMailAddress)
appOutlookRecip.Type = olTo 'Sets message to normal outgoing
e-mail message.
' Fill in the Subject line and main body of message.
.Subject = Me![Subject] 'Fill in the subject line.
.Body = Me![MessageBody] 'Fill in the message body.
'Add attachments, if any, to the e-mail message.
If Len(Me![Attachment]) > 0 Then
.Attachments.Add (Me![Attachment])
End If
.Send 'Send the completed message.
End With
myRecordSet.MoveNext 'Next record in recordset
countEm = countEm + 1 'Keeps track of number of messages printed for
later display.
Loop 'Repeat with next record, if not eof.
myRecordSet.Close 'All records processed when loop done. Close
recordset.
'If New Customers was selected, set NewCustEmailSent field to True.
If SendOptions.Value = 1 Then
DoCmd.SetWarnings False 'Temporarily hide warning messages.
'Update NewCustEmailSent to True.
'mySQL = "UPDATE [Address Book] SET [Address Book].NewCustEmailSent
= True " & _
' "WHERE [Address Book].NewCustEmailSent=False"
'DoCmd.RunSQL mySQL
DoCmd.SetWarnings True 'Unhide warning messages.
End If
'Display feedback message.
myMsg = countEm & " message(s) sent to Outlook's Outbox"
MsgBox (myMsg)
'All done when loop done. Clean up and say bye-bye.
Set myRecordSet = Nothing
Set appOutlookMsg = Nothing
Set appOutlook = Nothing
Set myConnection = Nothing
End Sub