Envio de correo

Hola y gracias

No te he comentado todos los campos que hay en esa hoja, y evidentemente en G1 hay una dirección de correo electrónico
a la que enviarse el libro, Si no el error habría sido demasiado gordo.
De hecho hay tres direcciones de correo G1, G2 y G3. En el futuro creo que las pasaré a hCli

En el programa, para simplificar solo he puesto la 1ª. Podría haber puesto dos o las tres.

Creo que te has basado para responderme en la instrucción
If IsEmpty(hPed.Cells(7, 2)) Then MsgBox "Falta Destinatario": End
Dos cosas
1ºDestinatario en este caso esta dirigido al usuario. Le informa de que no ha puesto el cliente al que se le destina la
operación de que se trate no el cliente de correo electrónico sino el cliente comprador, o cliente que pide información
etc, pero siempre es una entidad física o juridica.

2ª es una instrucción condicional, que si falla nos lleva a END.
Es decir : ahí se acabaría la macro y ni se copiaría el libro que tiene la dirección original ( hPed) ni se llegaría a
la instrucción de petición de envió de correo.

A un a pesar de correr el riesgo de parecer pesado creo que el error o bien está en el proceso de envió de correo o en
un "desentendimiento entre Excel y W2000
Te haría alguna pregunta si no tienes inconveniente
¿ que es lo que debe haber en G1, el nombre del destinatario "Desastres" o su correo
¿ha de tener algún formato concreto?, ¿ en el proceso de copiado->pegado solo valores se pierde lo que se ha de tener?
¿Porque lo que funcionó con w98 no lo hace con w2000 si es exactamente lo mismo?

Me preguntan, que tengo en el win.ini debajo de [Mail].
¿Puedes decirme que tienes tu?

Saludos
Des



escribió en el mensaje news:05d901c4b86f$3172e330$
Si guardas el libro lTem verás que en la celda G1 no tienes
nada, por lo tanto te falta la direccion.
Si pones B7, en lugar de B1, ya tendrás la dirección y te
enviará el correo.

Gracias.
He probado cai todo.
Me falta intentarlo haciendo el pino desde la ducha.

Te mando la macro . Ya me dirás donde está la majadería

Public Sub Guardar_Pedido_Y_Enviar_News()

Dim Imprimir As String
Dim Seguir As String

Dim lArt As Workbook
Dim lCli As Workbook
Dim lEst As Workbook
Dim lPed As Workbook
Dim lTem As Workbook

Dim hEst As Worksheet
Dim hPed As Worksheet
Dim hTem As Worksheet

Dim zlePed As Long

Set hPed = Workbooks("Pedidos.xls").Worksheets("Hoja1")
Set lCli = Workbooks("Clientes.xls")
Set lArt = Workbooks("Articulos.xls")

zlePed = hPed.Cells(65536, 3).End(xlUp).Row

Application.ScreenUpdating = False

If IsEmpty(hPed.Cells(7, 2)) Then MsgBox "Falta

Destinatario": End

If IsEmpty(hPed.Cells(7, 5)) Then MsgBox "Falta Nº ": End
If IsEmpty(hPed.Cells(8, 5)) Then MsgBox "Falta Fecha

": End

If IsEmpty(hPed.Cells(9, 5)) Then MsgBox "Falta

Descuento ": End

If IsEmpty(hPed.Cells(10, 5)) Then MsgBox "Falta

total": End

If IsEmpty(hPed.Cells(20, 2)) Then MsgBox "Falta

Codigo 1ª linea": End

If IsEmpty(hPed.Cells(20, 3)) Then MsgBox "Falta

cantidad en 1ª": End

'
Imprimir = MsgBox("¿ Buana, imprimo el pedido ?",

vbYesNo, "Desastres: Gestionamientacion")

Set lTem = Workbooks.Add 'Libro que luego intentaré

enviar

Set hTem = lTem.Worksheets(1)

hPed.Range("A1:Z" & zlePed).Copy
With hTem
.Paste
.Cells.Copy
.Cells.PasteSpecial xlValues
With Application
.CutCopyMode = False
.Goto Reference:=hTem.Cells(1, 1), Scroll:=True
End With
.Range("A19:A" & zlePed).ClearContents
.Columns("H:Z").Delete 'Elimino direccion de la

querida

.Columns("B:Z").AutoFit
.Columns(1).ColumnWidth = 8
.Columns(7).ColumnWidth = 40
End With

If Imprimir = vbYes Then
With hTem
With .PageSetup
.PrintTitleRows = "$1:$19"
.Orientation = xlPortrait
.PaperSize = xlPaperA4
End With
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1 ',

Collate:=True

End If



'> Hasta aqui funciona como un reloj.
'>Si desactivo la zona entre Asteriscos, envio de

Correo, el programa funciona

'********************************************************************

' Envio de CORREO ELECTRÓNICO

' no

funcionan-

lTem.SendMail Recipients:=hTem.Range("G1"),

Subject:="Pedido " '--No funciona

'ni con hTem.Range("G1")="desastres"
'ni con hTem.Range("G1")=""

'lTem.SendMail Recipients:="Desastres" ',

Subject:="Ajudaaaaaaaaaaaaaaa Pliiiiis "'--No funciona

'-


lTem.HasRoutingSlip = True ' Falla más que un trabuco

sin gatillo

With lTem.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("")
.Subject = "Envio de correo"
.Message = _
"¡" & _
"Hola Excelmaniacos, buenos días.!" & vbCr & _
"Os agradeceré lo deis un vistazo a la

zona Correo." & vbCr & _

"Si hay problema,( que lo hay) por favor,

indícamelo." & vbCr & vbCr & _

" Cordialmente" & vbCr & _
"Des"
End With
lTem.Route

'*******************************************************************

'--> A partir de aqui, de nuevo va como la seda.

Solo falla el envio de correo

lTem.SaveAs Filename:="C:\1A\Pedidos\" & "Ped-_" &

hPed.Cells(7, 5)

lTem.Close ' Nuevo Pedido Cerrado

'Abre ESTADISSTICAS copia filas a

Histórico y lo cierra

hPed.Range("B20:N" & zlePed).Copy
Set hEst Workbooks.Open("C:\1A\Estadisticas.xls").Worksheets("Movimientos")

hEst.Range("A65536").End(xlUp).Offset(1,

0).PasteSpecial Paste:=xlValues

Application.Goto

Reference:=hEst.Range("A65536").End(xlUp), Scroll:=True

Set lEst = Workbooks("Estadisticas.xls")

lEst.Close True

With hPed
.Range("B20:D" & zlePed).ClearContents
.Range("B7:B10").ClearContents
.Cells(7, 5) = .Cells(7, 5) + 1
.Cells(8, 5) = "=Today()"
End With

With Application
.Goto hPed.Range("A1"), True
.Goto hPed.Range("B7")
End With

Seguir = MsgBox("¿ Desea hacer mas pedidos ?",

vbYesNo, "Desastres:Pedido de Arcanos")

If Seguir = vbNo Then
Set lPed = Workbooks("Pedidos.xls")
lPed.Close True
lCli.Close
lArt.Close
End If

Set hEst = Nothing
Set hPed = Nothing
Set hTem = Nothing

Set lArt = Nothing
Set lCli = Nothing
Set lEst = Nothing
Set lPed = Nothing
Set lTem = Nothing
Application.ScreenUpdating = True 'Inmovilizo la pantalla
End Sub


Espero encuentres el troll

Saludos
Des


escribió en el

mensaje news:04f701c4b77d$b20df270$

Prueba entonces esto:
Puede que tengas que utilizar otro numero de libro, tal vez
workbooks(3), o mejor define el libro utilizando el nombre.
Suerte

Dim lTem As Workbook

Set lTem = Workbooks(1)

lTem.HasRoutingSlip = True

With lTem.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("")
.Subject = "Envio de correo"
.Message = _
"Hola Excelmaniacos, buenos días." & vbCr &
"Os agradeceré lo deis un vistazo." _
& vbCr & "Si hubiera algún problema, por favor,
indícamelo." & vbCr _
& "Saludos ." & vbCr & vbCr _
& " Cordialmente" _
& vbCr _
& "Des" _
& vbCr & vbCr & vbCr
End With
lTem.Route

No me funciona..
Me da error en

..HasRoutingSlip = True

Se ha producido el error 1004 en tiempo de ejecución:
error en el método HasRoutingSlip del objeto "_Workbook"

Por si acaso te explico. El programa que contiene la macro

ordena que otro libro sea copiado en un tercero.

El tercero es el que se quiere enviar por correo después

de alguna modificación

Por eso en lugar de ThisWprkbook utilizaba una variable




escribió en el

mensaje news:018901c4b6db$f7545a10$

Asi te funcionara


With ThisWorkbook
.HasRoutingSlip = True
With .RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("")
.Subject = "Titulo"
.Message = "texto del mensaje"
.ReturnWhenDone = True
End With
.Route
End With

As workbook

escribió en el

mensaje news:000b01c4b6d4$74da1db0$

¿cómo has definido lTem?

Buenas tardes
Con W2000-Excel2000- OE6

Puede decirme alguien donde esta el error en las

siguientes lineas

lTem.HasRoutingSlip = True --> se genera

erro Error

With lTem.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("Des", "CualquierOtro")
.Recipients = Array(hTem.Range("G1"),

hTem.Range("G2"))

.RoutingSlip.Subject = "Envio de correo"
.RoutingSlip.Message = _
"Hola Excelmaniacos, buenos días." & vbCr

& "Os agradeceré lo deis un vistazo." _

& vbCr & "Si hubiera algún problema, por

favor, indícamelo." & vbCr _

& "Saludos ." & vbCr & vbCr _
& " Cordialmente" _
& vbCr _
& "Des" _
& vbCr & vbCr & vbCr
.Route
End With


También da error la siguiente línea

lTem.SendMail "desastre@ latinmail.com" , "Consulta

1653"

Saludos
Des


.

.

.

.

Para responderte copié tu rutina, cree los ficheros (con
datos inventados) que utiliza y no funcionaba. Para
encontrar el error, incluí la línea
lTem.SaveAs "Temporal.xls"
para ver el contenido del libro temporal que creas y vi que
en la celda G1 no había contenido. Esa celda es la que
utilizas para el destinatario. Entonces modifiqué la linea
lTem.SendMail Recipients:=hTem.Range("G1"), Subject:="Pedido "
por
lTem.SendMail Recipients:=hTem.Range("B7"), Subject:="Pedido "
y ha funcionado. En B7 puse mi direccion de correo

Es posible que tu problema esté originado en el cliente de
correo que utilizas, por eso, en otro correo, te preguntaba
si podias enviar el mensaje mediante la opcion del menu. Si
eso te funciona, creo que se puede descartar que el
probleam sea ese.

En G1 debes poner la direccion

En win.ini, debajo de mail tengo:

MAPI=1
CMC=1
CMCDLLNAME=MAPI.DLL
CMCDLLNAME32=MAPI32.DLL
MAPIX=1
MAPIXVER=1.0.0.1
OLEMessaging=1

Hola y gracias

No te he comentado todos los campos que hay en esa hoja,

y evidentemente en G1 hay una dirección de correo electrónico

a la que enviarse el libro, Si no el error habría sido

demasiado gordo.

De hecho hay tres direcciones de correo G1, G2 y G3. En el

futuro creo que las pasaré a hCli

En el programa, para simplificar solo he puesto la 1ª.

Podría haber puesto dos o las tres.

Creo que te has basado para responderme en la instrucción
If IsEmpty(hPed.Cells(7, 2)) Then MsgBox "Falta

Destinatario": End

Dos cosas
1ºDestinatario en este caso esta dirigido al usuario. Le

informa de que no ha puesto el cliente al que se le destina la

operación de que se trate no el cliente de correo

electrónico sino el cliente comprador, o cliente que pide
información

etc, pero siempre es una entidad física o juridica.

2ª es una instrucción condicional, que si falla nos lleva

a END.

Es decir : ahí se acabaría la macro y ni se copiaría el

libro que tiene la dirección original ( hPed) ni se llegaría a

la instrucción de petición de envió de correo.

A un a pesar de correr el riesgo de parecer pesado creo

que el error o bien está en el proceso de envió de correo o en

un "desentendimiento entre Excel y W2000
Te haría alguna pregunta si no tienes inconveniente
¿ que es lo que debe haber en G1, el nombre del

destinatario "Desastres" o su correo

¿ha de tener algún formato concreto?, ¿ en el proceso de

copiado->pegado solo valores se pierde lo que se ha de tener?

¿Porque lo que funcionó con w98 no lo hace con w2000 si es

exactamente lo mismo?

Me preguntan, que tengo en el win.ini debajo de [Mail].
¿Puedes decirme que tienes tu?

Saludos
Des



escribió en el

mensaje news:05d901c4b86f$3172e330$

Si guardas el libro lTem verás que en la celda G1 no tienes
nada, por lo tanto te falta la direccion.
Si pones B7, en lugar de B1, ya tendrás la dirección y te
enviará el correo.

Gracias.
He probado cai todo.
Me falta intentarlo haciendo el pino desde la ducha.

Te mando la macro . Ya me dirás donde está la majadería

Public Sub Guardar_Pedido_Y_Enviar_News()

Dim Imprimir As String
Dim Seguir As String

Dim lArt As Workbook
Dim lCli As Workbook
Dim lEst As Workbook
Dim lPed As Workbook
Dim lTem As Workbook

Dim hEst As Worksheet
Dim hPed As Worksheet
Dim hTem As Worksheet

Dim zlePed As Long

Set hPed = Workbooks("Pedidos.xls").Worksheets("Hoja1")
Set lCli = Workbooks("Clientes.xls")
Set lArt = Workbooks("Articulos.xls")

zlePed = hPed.Cells(65536, 3).End(xlUp).Row

Application.ScreenUpdating = False

If IsEmpty(hPed.Cells(7, 2)) Then MsgBox "Falta

Destinatario": End

If IsEmpty(hPed.Cells(7, 5)) Then MsgBox "Falta Nº ": End
If IsEmpty(hPed.Cells(8, 5)) Then MsgBox "Falta Fecha

": End

If IsEmpty(hPed.Cells(9, 5)) Then MsgBox "Falta

Descuento ": End

If IsEmpty(hPed.Cells(10, 5)) Then MsgBox "Falta

total": End

If IsEmpty(hPed.Cells(20, 2)) Then MsgBox "Falta

Codigo 1ª linea": End

If IsEmpty(hPed.Cells(20, 3)) Then MsgBox "Falta

cantidad en 1ª": End

'
Imprimir = MsgBox("¿ Buana, imprimo el pedido ?",

vbYesNo, "Desastres: Gestionamientacion")

Set lTem = Workbooks.Add 'Libro que luego intentaré

enviar

Set hTem = lTem.Worksheets(1)

hPed.Range("A1:Z" & zlePed).Copy
With hTem
.Paste
.Cells.Copy
.Cells.PasteSpecial xlValues
With Application
.CutCopyMode = False
.Goto Reference:=hTem.Cells(1, 1), Scroll:=True
End With
.Range("A19:A" & zlePed).ClearContents
.Columns("H:Z").Delete 'Elimino direccion de la

querida

.Columns("B:Z").AutoFit
.Columns(1).ColumnWidth = 8
.Columns(7).ColumnWidth = 40
End With

If Imprimir = vbYes Then
With hTem
With .PageSetup
.PrintTitleRows = "$1:$19"
.Orientation = xlPortrait
.PaperSize = xlPaperA4
End With
End With
ActiveWindow.SelectedSheets.PrintOut Copies:=1 ',

Collate:=True

End If



'> Hasta aqui funciona como un reloj.
'>Si desactivo la zona entre Asteriscos, envio de

Correo, el programa funciona

'********************************************************************

' Envio de CORREO ELECTRÓNICO

' no

funcionan-

lTem.SendMail Recipients:=hTem.Range("G1"),

Subject:="Pedido " '--No funciona

'ni con hTem.Range("G1")="desastres"
'ni con hTem.Range("G1")=""

'lTem.SendMail Recipients:="Desastres" ',

Subject:="Ajudaaaaaaaaaaaaaaa Pliiiiis "'--No funciona

'-


lTem.HasRoutingSlip = True ' Falla más que un trabuco

sin gatillo

With lTem.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("")
.Subject = "Envio de correo"
.Message = _
"¡" & _
"Hola Excelmaniacos, buenos días.!" &

vbCr & _

"Os agradeceré lo deis un vistazo a la

zona Correo." & vbCr & _

"Si hay problema,( que lo hay) por favor,

indícamelo." & vbCr & vbCr & _

" Cordialmente" & vbCr & _
"Des"
End With
lTem.Route

'*******************************************************************

'--> A partir de aqui, de nuevo va como la seda.

Solo falla el envio de correo

lTem.SaveAs Filename:="C:\1A\Pedidos\" & "Ped-_" &

hPed.Cells(7, 5)

lTem.Close ' Nuevo Pedido Cerrado

'Abre ESTADISSTICAS copia filas a

Histórico y lo cierra

hPed.Range("B20:N" & zlePed).Copy
Set hEst >Workbooks.Open("C:\1A\Estadisticas.xls").Worksheets("Movimientos")

hEst.Range("A65536").End(xlUp).Offset(1,

0).PasteSpecial Paste:=xlValues

Application.Goto

Reference:=hEst.Range("A65536").End(xlUp), Scroll:=True

Set lEst = Workbooks("Estadisticas.xls")

lEst.Close True

With hPed
.Range("B20:D" & zlePed).ClearContents
.Range("B7:B10").ClearContents
.Cells(7, 5) = .Cells(7, 5) + 1
.Cells(8, 5) = "=Today()"
End With

With Application
.Goto hPed.Range("A1"), True
.Goto hPed.Range("B7")
End With

Seguir = MsgBox("¿ Desea hacer mas pedidos ?",

vbYesNo, "Desastres:Pedido de Arcanos")

If Seguir = vbNo Then
Set lPed = Workbooks("Pedidos.xls")
lPed.Close True
lCli.Close
lArt.Close
End If

Set hEst = Nothing
Set hPed = Nothing
Set hTem = Nothing

Set lArt = Nothing
Set lCli = Nothing
Set lEst = Nothing
Set lPed = Nothing
Set lTem = Nothing
Application.ScreenUpdating = True 'Inmovilizo la

pantalla

End Sub


Espero encuentres el troll

Saludos
Des


escribió en el

mensaje news:04f701c4b77d$b20df270$

Prueba entonces esto:
Puede que tengas que utilizar otro numero de libro, tal vez
workbooks(3), o mejor define el libro utilizando el nombre.
Suerte

Dim lTem As Workbook

Set lTem = Workbooks(1)

lTem.HasRoutingSlip = True

With lTem.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("")
.Subject = "Envio de correo"
.Message = _
"Hola Excelmaniacos, buenos días." & vbCr &
"Os agradeceré lo deis un vistazo." _
& vbCr & "Si hubiera algún problema, por favor,
indícamelo." & vbCr _
& "Saludos ." & vbCr & vbCr _
& " Cordialmente" _
& vbCr _
& "Des" _
& vbCr & vbCr & vbCr
End With
lTem.Route

No me funciona..
Me da error en

..HasRoutingSlip = True

Se ha producido el error 1004 en tiempo de ejecución:
error en el método HasRoutingSlip del objeto "_Workbook"

Por si acaso te explico. El programa que contiene la macro

ordena que otro libro sea copiado en un tercero.

El tercero es el que se quiere enviar por correo después

de alguna modificación

Por eso en lugar de ThisWprkbook utilizaba una variable




escribió en el

mensaje news:018901c4b6db$f7545a10$

Asi te funcionara


With ThisWorkbook
.HasRoutingSlip = True
With .RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("")
.Subject = "Titulo"
.Message = "texto del mensaje"
.ReturnWhenDone = True
End With
.Route
End With

As workbook

escribió en el

mensaje news:000b01c4b6d4$74da1db0$

¿cómo has definido lTem?

Buenas tardes
Con W2000-Excel2000- OE6

Puede decirme alguien donde esta el error en las

siguientes lineas

lTem.HasRoutingSlip = True --> se genera

erro Error

With lTem.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("Des", "CualquierOtro")
.Recipients = Array(hTem.Range("G1"),

hTem.Range("G2"))

.RoutingSlip.Subject = "Envio de correo"
.RoutingSlip.Message = _
"Hola Excelmaniacos, buenos días." & vbCr

& "Os agradeceré lo deis un vistazo." _

& vbCr & "Si hubiera algún problema, por

favor, indícamelo." & vbCr _

& "Saludos ." & vbCr & vbCr _
& " Cordialmente" _
& vbCr _
& "Des" _
& vbCr & vbCr & vbCr
.Route
End With


También da error la siguiente línea

lTem.SendMail "desastre@ latinmail.com" , "Consulta

1653"

Saludos
Des


.

.

.

.

.