Desde una pestaña de un archivo excel, crear mail, pero NO ENVIAR, sino meterlo en carpeta "borrado

[maumaumau]

Es la primera vez que escribo en este foro, y supongo que se notará.

A base de leeros y del "corta+pega", he hecho una macro que funciona correctamente para lo siguiente:

Tengo un archivo excel con varias pestañas. Me situo en una de ellas, y con la macro que diré, pulsando "Ctrl+s", me envía un mensaje de mail (outlook 2003), al destinatario que le digo, con el asunto que le digo y con un archivo excel que sólo es la pestaña en concreto en donde me he situado para pulsar "Ctrl+s".

Además, después me elimina el archivo temporal creado con ese archivo enviado (esa pestaña).

Va muy bien!!! (gracias por dejar copiar).

PERO ahora pretendo otra macro, con eso mismo, PERO QUE NO ENVÍE EL MENSAJE DIRECTAMENTE, sino que se guarde en la carpeta "Borrador" de mi outlook, para que pueda modificar el texto manualmente.

Alguién le apetece echarme una mano.

Por supuesto, adjunto el texto de la macro que me funciona:

*****************

Sub prov()

'

' prov Macro

' Macro grabada el 04/02/2013 por Mau

'

' Acceso directo: CTRL+s

'Sub mail()

'

'

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim Destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim I As Long

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

Set Sourcewb = ActiveWorkbook

'Copia la hoja a un libro nuevo

ActiveSheet.Copy

Set Destwb = ActiveWorkbook

'Determina la versión de Excel y la extensión del archivo

With Destwb

If Val(Application.Version) < 12 Then

'Estamos utilizando 97-2003...

FileExtStr = ".xls": FileFormatNum = -4143

End If

End With

'Grabamos la hoja que enviaremos por correo

TempFilePath = Environ$("temp") & "\"

TempFileName = Range("b9")

With Destwb

.SaveAs TempFilePath & TempFileName & FileExtStr, _

FileFormat:=FileFormatNum

For I = 1 To 1

' Modifica el correo del destinatario y el asunto

Set OutApp = CreateObject("Outlook.Application")

OutApp.Session.logon

Set OutMail = OutApp.CreateItem(0)

With OutMail

.To = "xxxxxxx@xxxxxxxxxxx.com"

'y agregamos la variable:

.Subject = Range("b9") & " " & Range("B4")

.Body = "xxxxxxxx poner comentarios xxxxxxx del expediente" & " - " & Range("b9")

.Attachments.Add TempFilePath & TempFileName & FileExtStr

.Attachments.Add TempFilePath & TempFileName & FileExtStr

.send

End With

If Err.Number = 0 Then Exit For

Next I

On Error GoTo 0

.Close SaveChanges:=False

End With

'Elimina el archivo temporal que se ha creado

Kill TempFilePath & TempFileName & FileExtStr

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

End Sub

************************

[maumaumau]

Re: Desde una pestaña de un archivo excel, crear mail, pero NO ENVIAR, sino meterlo en carpeta "borrador

Creo que ya he dado con la solución.

Se pone, en vez de ".send", ".save" y te lo guarda en la carpeta de "Bandeja de Entrada" de Outlook, pero sin enviar, y sin destinatario.

Luego pinchas sobre ese mensajes, y lo puedes modificar.

Sea como sea, aquí os pongo mi "obra maestra?" que he hecho a base de "copia+pega".

Espero que a alguien le pueda servir.

Y yo doy por cerrado este hilo, pues ya tengo la respuesta.

Saludos, y gracias a todos por estar ahí.

---------------------

-------------------

' Cuando salga algo escrito con "'" delante, se puede quitar y sirve

' Las instrucciones van entre ()

' Al "sub" de abajo se le tienen que quitar las "'"

'Sub aprovi()

' aprovi Macro

' Macro grabada el 04/02/2013 por Papas

'

' Acceso directo: CTRL+s

'

' Dim FileExtStr As String

' Dim FileFormatNum As Long

' Dim Sourcewb As Workbook

' Dim Destwb As Workbook

' Dim TempFilePath As String

' Dim TempFileName As String

' Dim I As Long

' (Esto que sale abajo, entre "'", hay que ponerlos sin las "'")

' With Application

' .ScreenUpdating = False

' .EnableEvents = False

' End With

' Set Sourcewb = ActiveWorkbook

'(Copia la hoja a un libro nuevo)

' ActiveSheet.Copy

' Set Destwb = ActiveWorkbook

'(Determina la versión de Excel y la extensión del archivo)

'With Destwb

' If Val(Application.Version) < 12 Then

'(Estamos utilizando 97-2003, por lo que la extensión es xls)

' FileExtStr = ".xls": FileFormatNum = -4143

' End If

' End With

'(Grabamos la hoja que enviaremos por correo, ...

'(...o bien en un archivo temporal que luego se borra,

' (...o bien, donde le digamos)

' TempFilePath = "C:\Documents and Settings\Pc de Mau\Escritorio" & "\"

' TempFilePath = Environ$("temp") & "\"

' (Le pone el nombre que aparezca en la casilla "Range" o el que le digamos)

' TempFileName = "Relación de expedientes de la remesa"

' TempFileName = Range("b9")

' (Ahora guarda conforme nuestra anterior instrucción)

'With Destwb

' .SaveAs TempFilePath & TempFileName & FileExtStr, _

' FileFormat:=FileFormatNum

' (Si una vez guardado, lo quiero cerrar, escribo en el...)

'(...renglón siguiente, sin comillas ".close")

' For I = 1 To 1

' (Se van añadiendo los datos al correo que queremos enviar)

'Set OutApp = CreateObject("Outlook.Application")

'OutApp.Session.logon

'Set OutMail = OutApp.CreateItem(0)

'With OutMail

'.To = "Dirección de correo:

[TABLE=class: outer_border, width: 75%]

[TR]

[TD]Únicamente los administradores pueden visualizar esta información.

[/TD]

[/TR]

[/TABLE]

(Le pone el nombre al asunto, o bien el que le digamos (entre comillas),...)

' (...o el de la casilla que indiquemos en el Range)

'.Subject = Range("b9") & " - " & Range("B4") & " - " & "Información"

'.Body = "Estimados compañeros:" & vbNewLine & "xxxxxxxx poner comentarios xxxxxxx del expediente" & " - " & Range("b9")

' (Adjunta el archivo creado. También puede adjuntar un archivo poniendo la ruta)

'.Attachments.Add TempFilePath & TempFileName & FileExtStr

'.Attachments.Add "C:\Documents and Settings\Pc de Mau\Escritorio\ xx nombre y extensión del archivoXX"

' (Con "save" guarda el mail preparado en la "carpeta de entrada", SIN ENVIAR,...)

' (...y con "send" se envía)

'.Save

'End With

' If Err.Number = 0 Then Exit For

' Next I

' On Error GoTo 0

' .Close SaveChanges:=False

' End With

'(Elimina el archivo temporal que se ha creado)

' Kill TempFilePath & TempFileName & FileExtStr

' With Application

' .ScreenUpdating = True

' .EnableEvents = True

' End With

'End Sub

*****************************************

*****************************************

----------------------