Help with email sub()

[jose luis]

Hi all,

I'm trying to send a worksheet with Shapes on it (Logos and
TextFrames).
i have this code running fine on my PC, but when I try to run it on
other PC it fails in the line ".Item.Send"


Here is the code of the UserForm used to set the email data.


Code:
--------------------
UserFrom Code
Private Sub UserForm_Initialize()

Cliente.Text = Range("ClteActivo")
If Len(Range("ContactoActivo")) <= 3 Then
Contacto.Text = "sin contacto"
Solonombre = "Cliente"
Else
Contacto.Text = Range("ContactoActivo")
Solonombre = Left(Contacto.Text, InStr(1, Contacto.Text, " ", vbTextCompare))
End If
email.Text = Range("emailactivo")
Ccmail.Text = "inserte e-mail adicional (opcional)"
Asunto.Text = "Cotizacion Solicitada"
Intro.Text = "Estimado " & Solonombre & " le envio la cotización que solicitó. Agradecemos su confianza."
End Sub

Private Sub Enviar_Click()
If InStr(1, email.Text, "@", vbTextCompare) = 0 Or Len(Asunto) < 4 Or Asunto <= " " Then
MsgBox "'e-mail' o 'Asunto' incompletos, corrija por favor", vbExclamation, Title:="Error en Datos"
Else
Send_Range
Range("AZ200").Select
Unload Me
End If
End Sub
Private Sub Cancel_Click()
Unload Me
End Sub

Private Sub Ccmail_AfterUpdate()
resp = InStr(1, Ccmail.Text, "@", vbTextCompare)
If resp = 0 Then
MsgBox "e-mail incompleto(falta '@' )", vbExclamation, Title:=""
Ccmail.Text = ""
End If
End Sub
Private Sub Contacto_AfterUpdate()
Dim Introbase As String

Introbase = Intro
If Len(Contacto) < 4 Or Contacto <= " " Then
MsgBox "Teclee un nombre válido", vbInformation, Title:=""
Else
pos1 = InStr(1, Introbase, " ", vbTextCompare)
pos2 = InStr(pos1 + 1, Introbase, " ", vbTextCompare)
nombreextraido = Left(Introbase, pos2 - 1)
nombreextraido1 = Right(nombreextraido, (pos2 - 1) - pos1)
Intro.Text = Replace(Introbase, nombreextraido1, Contacto, 1, 1)
End If
End Sub

Private Sub email_AfterUpdate()
resp = InStr(1, email.Text, "@", vbTextCompare)
If resp = 0 Then
MsgBox "e-mail incompleto(falta '@' )", vbExclamation, Title:=""
End If
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = 0 Then Cancel = True
End Sub
--------------------



After entering the data I used this code to send the mail (found in
this forum, Thanks to the developer!!):


Code:
--------------------
Sub Send_Range()
Dim nombre, Asunto, Intro As String

' Hace copia de Hoja a enviar y quita proteccion.
Sheets("Impresión").Copy
ActiveSheet.Unprotect Password:="104060"
nWBook = Left(ActiveWorkbook.Name, 100)

' Select the range of cells on the active worksheet.

ActiveSheet.Range("B3:F49").Select
nombre = DatosEmailCotzn.email.Text
Asunto = DatosEmailCotzn.Asunto.Text
Intro = DatosEmailCotzn.Intro.Text
If DatosEmailCotzn.Ccmail.Text = "inserte e-mail adicional (opcional)" Then
ConCopia = ""
Else
ConCopia = DatosEmailCotzn.Ccmail.Text
End If
' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True

' Set the optional introduction field thats adds
' some header text to the email body. It also sets
' the To and Subject lines. Finally the message
' is sent.

With ActiveSheet.MailEnvelope
.Introduction = Intro
.Item.To = nombre
.Item.Subject = Asunto
.Item.CC = ConCopia
.Item.Send
End With

'Desaparece la hoja copiada y regresa a Hermes

Application.DisplayAlerts = False
Workbooks(nWBook).Close
Application.DisplayAlerts = True

End Sub
--------------------


Could you give some hints on how to run the code in other PC's? Where
do you think is the problem?
(I already set the References Microsoft Outlook in VBA)


Thanks in advance

Regards

Jose Luis

 

[Ron de Bruin]

Hi Jose

This is only working in 2002/2003

Also not working If the other user have a different offce version then his Outlook version..

 

[jose luis]

Thanks Ron for your response,

Now i see the reason!

In your email page routines do you have one that could send images,
text boxes and text on a worlsheet?

I already tryed some without luck, surely due to bad implementation,
Could you point me in the right direction?

Thanks again for your time, knowledge and patience.

Best regards

Jose Luis

 

[Ron de Bruin]

Hi Jose

From my site:

If you use Office 2002 or 2003 see this KB article.

How to Send a Range of Cells Using VBA. (with shapes)
http://support.microsoft.com/default.aspx?scid=kb;en-us;816644

 

[Ron de Bruin]

Oops, send you wrong information

No I have only a example without shapes
http://www.rondebruin.nl/mail/folder3/mail2.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl

Hi Jose

From my site:

If you use Office 2002 or 2003 see this KB article.

How to Send a Range of Cells Using VBA. (with shapes)
http://support.microsoft.com/default.aspx?scid=kb;en-us;816644

 

[jose luis]

Thanks again Ron


I tryed with your suggestion just taking out of the code this part


Code
-------------------
'For Each myshape In Nwb.Sheets(1).Shapes
'myshape.Delete
'Nex
-------------------


The sub() works and sends the worksheet, even sends the logos(shapes
and textboxes but for some reason the outlook can't display them. Ca
you give some clues about this?

your help and comments always valued.

Regards
Jose Luis

 

[Ron de Bruin]

The function can not make html from pictures

The function save the file as html file.(tempfile)
If you save a Excel file with pictures/controls as html it will create a html file and a folder with the
pictures for you.

I delete the shapes first so It don't create that folder, I do not have to delete the folder in my code then.
I use Kill tempfile at the end to delete the html file