save and email button

[Steve E]

Hi,
I've been to Ron DeBruin's site and have borrowed some code from there as
well as some info from other posts here trying t o cobble together the right
set of instructions to do the following in Excel2003:

I have a protected workbook with protected worksheets that is a *.xlt
(template) file.

The only sheet that my 'user' sees is a quote form - they select a set of
criteria and I return a price.

My users are all remote from our offices and I want to have a 'save and
register' macro on that form that saves a copy of the workbook on their c
drive [ c:\quotes\"wb.name" ] and email a copy of the workbook to a monitored
email address ([email protected]).

Since I want this to be the only way a user can save the quote I also want
to disable the "save" and "save as" File menu options

So based on what I gleaned from these sources I have the following:

In the 'ThisWorkbook' module:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

End Sub
'Removes the save button from the toolbar and removes save from file menu
'User should only save by using save command button

In the Sheet1 code:

Public MySave As Boolean

Sub SaveAndEmailtoRegisterQuote()

MySave = True
Dim iMsg As Object
Dim iConf As Object
Dim wb As Workbook
Dim WBname As String
' Dim sPath As String
' Dim Flds As Variant

Application.ScreenUpdating = False
Set wb = ActiveWorkbook

' It will save a copy of the file in C:\Quotes\ with a Date and Time
stamp
WBname = ActiveSheet.Range("ProjectName") & " " & Format(Now,
"dd-mm-yy h-mm-ss") & ".xls"
wb.SaveCopyAs "C:\Quotes\" & WBname

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

' iConf.Load -1 ' CDO Source Defaults
' Set Flds = iConf.Fields
' With Flds
'
..Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in
your SMTP server here"
'
..Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
' .Update
' End With

With iMsg
Set .Configuration = iConf
.To = "(e-mail address removed)" & ";" &
Sheets("Sheet1").Range("SalesRep_EmailAddress").Value
.CC = "(e-mail address removed)"
.BCC = ""
.From = Sheets("Sheet1").Range("Contact_EmailAddress").Value
.Subject = "This is a test"
.TextBody = "This is the body text"
.AddAttachment "C:\Quotes\" & WBname
.Send
End With

'If you not want to delete the file you send delete this line
' Kill "C:\Quotes?" & WBname

Set iMsg = Nothing
Set iConf = Nothing
Set wb = Nothing
Application.ScreenUpdating = True

If Not MySave Then
Cancel = True
Else
MySave = False
End If
End Sub


With the "Sub SaveAndEmailtoRegisterQuote()" assigned to the button on my
worksheet as a macro.

I also set up a c:\quotes\ directory

I followed RdB's hint about setting the reference to Microsoft Outlook 11.0
Object Library (this is the version that matches my Excel version in the
reference list).

When I run the code (click the button) I get the following:

"System Error: &H80040220 (-2147220960)"

Anyone feel like helping this newbie figure out where the heck he's gone
wrong?

Thanks in advance,

Steve

 

[Simon Lloyd]

The only problem i can see when i tried your code was that you dont
physically open a mail programm such as outlook, i think this might be
why it gives you an automation problem...the rest of your code seemed
to work fine!

Hope this helps, as i am no expert by far!

Regards,
Simon

 

[Steve E]

Hi Simon,

Thanks for looking at this for me. I chose to plagerize Ron'd code for the
CDOSYS methodology because I don't think that I have control / knowledge
regarding the email app that my customers (users) are using and liked the
idea that he put forward... and I hate to start compromising at this early
point... or did I miss-understand the point of Ron's code? This is what I am
trying to work from: http://www.rondebruin.nl/cdo.htm
but adding the code to disable the save and saveas menu and toolbar options
to force the 'registration' via email.
Do you think I should take a step back and just try and make it work via
Outlook first? (or is that even a step back - I thought it made it more
complicated since I don't have control over what versions of Outlook are in
my user group?

Help!!!

Steve

 

[Steve E]

Simon,

Quickly, thanks for looking at this for me. I figured out the things that I
had wrong in my code.
Basically, I had the section of code related to the set.fields line
commented out (as I'd copied it from Ron's site) AND had the file path's
coded as c:/ instead of c:\) once I cleaned these up (and entered my smtp
info correctly!) it works fine.

Thanks again!

Steve