View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
jose luis jose luis is offline
external usenet poster
 
Posts: 1
Default Help with email sub()


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 Wrote:
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..



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


"jose luis"
wrote in message
...

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


--
jose luis

------------------------------------------------------------------------
jose luis's Profile:

http://www.excelforum.com/member.php...o&userid=13312
View this thread:

http://www.excelforum.com/showthread...hreadid=390796



--
jose luis
------------------------------------------------------------------------
jose luis's Profile: http://www.excelforum.com/member.php...o&userid=13312
View this thread: http://www.excelforum.com/showthread...hreadid=390796