View Single Post
  #6  
Old May 12th 08, 09:23 PM posted to microsoft.public.outlook.program_vba
Sue Mosher [MVP-Outlook]
external usenet poster
 
Posts: 11,608
Default Possible to Disable Object Model Guard?

I don't do CDO for Windows programming. The page at http://www.paulsadowski.com/WSH/cdo.htm is an excellent reference and shows how you need to provide configuration information about the SMTP server to be used for sending the message.

--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"ryguy7272" wrote in message ...
I did some editing; still get errors.
Error occurs he
Set .Configuration = cdoConfig


Entire macro:
Sub Send_Files()

Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range




With Application
.EnableEvents = False
.ScreenUpdating = False
End With



Set sh = Sheets("Send Emails")

Set myMail = CreateObject("CDO.Message")
Set objMessage = CreateObject("CDO.Message")



For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConst ants)


Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")


If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) 0 Then




With cdoMessage
Set .Configuration = cdoConfig
'.From = ""
.To = cell.Value
.Subject = "Sample CDO Message"
.TextBody = "Hi " & cell.Offset(0, -1).Value



For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) "" Then
If Dir(FileCell.Value) "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Send
End With


Set objMessage = Nothing
Set myMail = Nothing

End If

Next cell

With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

I've hit a wall again. I've seen your name all over the Outlook-Programming
DGs. and I'll bet anything you know what to do from here Sue. I want to
learn this, so please tell me what to do to resolve the problem, or please
refer me to a resource on the web that explains what to do.

Regards,
Ryan---

--
RyGuy


"Sue Mosher [MVP-Outlook]" wrote:

Which statement is raising the error? Why are you coding both the Outlook.MailItem, which you know will raise security prompts, and the CDO.Message, which won't?


"ryguy7272" wrote in message news
Thanks for the follow up Sue. I guess I still don't understand what makes
this work or not work. Not, I am using this code:

With OutMail
objMessage.To = cell.Value
objMessage.Subject = "Sales Reps. Data"
objMessage.Body = "Sales Reps. Data"

.To = cell.Value
.Subject = "Sales Reps. Data"
.Body = "Hi " & cell.Offset(0, -1).Value

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) "" Then
If Dir(FileCell.Value) "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

objMessage.Send
End With

When code runs I get this:
Object doesn't support this property or method.

What am I doing wrong. If there is something specific that I need to know,
please tell me. I don't know much about Outlook at all.

Regards,
Ryan---




--
RyGuy


"Sue Mosher [MVP-Outlook]" wrote:

If you read that page, you'd know that the object model guard can't be disabled except by an Exchange administrator.

Your code creates a CDO.Message object but never sends it. That's an approach you can take, instead of using Outlook objects and getting prompts.



"ryguy7272" wrote in message ...
I read the information he
http://www.outlookcode.com/article.aspx?id=52

It is very interesting. Maybe I missed something, but I still can't seem to
disable the Outlook Object Model Guard. I am sending multiple emails from
Excel. code is below:
Sub Send_Files()
'Working in 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim sh As Worksheet
Dim cell As Range, FileCell As Range, rng As Range




With Application
.EnableEvents = False
.ScreenUpdating = False
End With



Set sh = Sheets("Send Emails")


Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

Set objMessage = CreateObject("CDO.Message")


For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConst ants)



'Enter the file names in the C:Z column in each row
Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1")



If cell.Value Like "?*@?*.?*" And _
Application.WorksheetFunction.CountA(rng) 0 Then
Set OutMail = OutApp.CreateItem(0)



With OutMail
objMailItem.To = cell.Value
'.To = cell.Value
.Subject = "Sales Reps. Data"
.Body = "Hi " & cell.Offset(0, -1).Value

For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
If Trim(FileCell) "" Then
If Dir(FileCell.Value) "" Then
.Attachments.Add FileCell.Value
End If
End If
Next FileCell

.Send 'Or use Display
End With



Set OutMail = Nothing
End If
Next cell



Set OutApp = Nothing


With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


Is there any way to disable that Model Guard with code?

Thanks,
Ryan---


--
RyGuy


Ads
 

Mobile Phones - Mortgage - Pink Ranger - Mortgages - Consumer information