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

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

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

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...b;en-us;816644


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


"jose luis" wrote in message
...

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

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


"Ron de Bruin" wrote in message ...
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...b;en-us;816644


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


"jose luis" wrote in message
...

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

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


"Ron de Bruin" wrote in messag
...
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...b;en-us;816644


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


"jose luis"
wrote in message
...

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 ba
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 versio
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 i
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ó
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





--
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

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



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


"jose luis" wrote in message
...

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
'Next
--------------------


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

your help and comments always valued.

Regards
Jose Luis




Ron de Bruin Wrote:
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


"Ron de Bruin" wrote in message
...
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...b;en-us;816644


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


"jose luis"
wrote in message
...

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





--
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