![]() |
| If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|||||||
| Tags: disable, guard, model, object, possible |
|
|
|
Thread Tools | Display Modes |
|
#1
|
|||
|
|||
|
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 |
|
#2
|
|||
|
|||
|
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. -- 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 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 |
|
#3
|
|||
|
|||
|
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. -- 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 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 |
|
#4
|
|||
|
|||
|
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?
-- 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 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 |
|
#5
|
|||
|
|||
|
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? -- 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 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 |
|
#6
|
|||
|
|||
|
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 |
|
#7
|
|||
|
|||
|
Good site Sue, unfortunately I still get an error...
Error says: 'The SendUsing configuration value is invalid' This is the line that causes the error: objMessage.Send The Object Model Guard pops up again if I change the line to this: ..Send Below is my full code: 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") '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 objMessage.Subject = "Example CDO Message" objMessage.From = " objMessage.To = cell.Value objMessage.TextBody = "This is some sample message text." .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 Set OutMail = Nothing End If Next cell Set OutApp = Nothing Set objCDOMail = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub I am receptive to ideas... Thanks to all who looked. Ryan-- -- RyGuy "Sue Mosher [MVP-Outlook]" wrote: 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 |
|
#8
|
|||
|
|||
|
Go back to the article I suggested and look at the details for working with the Message.Configuration object and setting its field values.
-- 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 ... Good site Sue, unfortunately I still get an error... Error says: 'The SendUsing configuration value is invalid' This is the line that causes the error: objMessage.Send The Object Model Guard pops up again if I change the line to this: .Send Below is my full code: 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") '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 objMessage.Subject = "Example CDO Message" objMessage.From = " objMessage.To = cell.Value objMessage.TextBody = "This is some sample message text." .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 Set OutMail = Nothing End If Next cell Set OutApp = Nothing Set objCDOMail = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub I am receptive to ideas... Thanks to all who looked. Ryan-- -- RyGuy "Sue Mosher [MVP-Outlook]" wrote: 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. "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 |
|
#9
|
|||
|
|||
|
Get rid of all that Outlook stuff. You are using CDO. CDO is independant of
Outlook. Use ONLY CDO. Your warnings are popping up because you are trying to get Outlook to send mail. Use only CDO. No Outlook. "ryguy7272" wrote in message ... Good site Sue, unfortunately I still get an error... Error says: 'The SendUsing configuration value is invalid' This is the line that causes the error: objMessage.Send The Object Model Guard pops up again if I change the line to this: .Send Below is my full code: 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") '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 objMessage.Subject = "Example CDO Message" objMessage.From = " objMessage.To = cell.Value objMessage.TextBody = "This is some sample message text." .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 Set OutMail = Nothing End If Next cell Set OutApp = Nothing Set objCDOMail = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub I am receptive to ideas... Thanks to all who looked. Ryan-- -- RyGuy "Sue Mosher [MVP-Outlook]" wrote: 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 |
|
#10
|
|||
|
|||
|
Welcome to the party Paul. I believe there is a way to send multiple emails, via Outlook, without those warnings popping up every 5 second, but I have never actually done it. I tried your method, and eliminated all of the Outlook references, and as far as I can tell now, I rely only on CDO to do the job, but now I get an error message saying 'The 'Sendusing' configuration is invalid.'. Code breaks he myMail.Send Entire macro he Sub Send_Files() Dim OutMail As Object Dim sh As Worksheet Dim cell As Range, FileCell As Range, rng As Range Set myMail = CreateObject("CDO.Message") myMail.Subject = "Sending email with CDO" With Application .EnableEvents = False .ScreenUpdating = False End With Set sh = Sheets("Send Emails") 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 OutMail myMail.To = cell.Value myMail.Subject = "Sales Reps. Data" myMail.TextBody = "Hi " & cell.Offset(0, -1).Value For Each FileCell In rng.SpecialCells(xlCellTypeConstants) If Trim(FileCell) "" Then If Dir(FileCell.Value) "" Then myMail.AddAttachment FileCell.Value End If End If Next FileCell myMail.Send End With Set OutMail = Nothing End If Next cell Set myMail = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub If anyone can tweak the code and get this thing to work I'd appreciate it. My CDO ideas came from he http://www.w3schools.com/asp/asp_send_email.asp Regards, Ryan--- -- RyGuy "Paul R. Sadowski" wrote: Get rid of all that Outlook stuff. You are using CDO. CDO is independant of Outlook. Use ONLY CDO. Your warnings are popping up because you are trying to get Outlook to send mail. Use only CDO. No Outlook. "ryguy7272" wrote in message ... Good site Sue, unfortunately I still get an error... Error says: 'The SendUsing configuration value is invalid' This is the line that causes the error: objMessage.Send The Object Model Guard pops up again if I change the line to this: .Send Below is my full code: 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") '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 objMessage.Subject = "Example CDO Message" objMessage.From = " objMessage.To = cell.Value objMessage.TextBody = "This is some sample message text." .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 Set OutM |