Desde una pestaña de un archivo excel, crear mail, pero NO ENVIAR, sino meterlo en carpeta "borrado
publicado
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
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
************************