Envio de correo

se me olvidaba.
Prueba a enviar el correo desde el menu archivo-enviar
a-destinatario de correo con adjunto

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


.

.

.

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


.

.

.

Ya lo he hecho
escribió en el mensaje news:0c6d01c4b77e$6bf9ecc0$
se me olvidaba.
Prueba a enviar el correo desde el menu archivo-enviar
a-destinatario de correo con adjunto

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


.

.

.

Ya he enviado correo de esta manera, pero no es lo que deseo.
Pretendo hacerlo automaticamente.

Lo probé para, grabando el proceso, ver que es lo que me daba el grabador.
Respuesta: nada.
También lo hice porque quise comprobar que se podía hacer.
Lo que no consigo es hacerlo con programa.

Saludos
Des



escribió en el mensaje news:0c6d01c4b77e$6bf9ecc0$
se me olvidaba.
Prueba a enviar el correo desde el menu archivo-enviar
a-destinatario de correo con adjunto

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


.

.

.

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


.

.

.

.