Foro Oficial Office Outlook

Sub MakeTaskFromMail2(MyMail As Outlook.MailItem)
    Dim strID As String
    Dim olNS As Outlook.NameSpace
    Dim olMail As Outlook.MailItem
    Dim objTask As Outlook.TaskItem
    
    strID = MyMail.EntryID
    Set olNS = Application.GetNamespace("MAPI")
    Set olMail = olNS.GetItemFromID(strID)
    Set objTask = Application.CreateItem(olTaskItem)
    With objTask
        .Subject = olMail.Subject
        .DueDate = olMail.SentOn
        .Body = olMail.Body
    End With
    Call CopyAttachments(olMail, objTask)
    objTask.Save
    
    Set objTask = Nothing
    Set olMail = Nothing
    Set olNS = Nothing
End Sub

Sub CopyAttachments(objSourceItem, objTargetItem)
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
   strPath = fldTemp.Path & "\"
   For Each objAtt In objSourceItem.Attachments
      strFile = strPath & objAtt.FileName
      objAtt.SaveAsFile strFile
      objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
      fso.DeleteFile strFile
   Next

   Set fldTemp = Nothing
   Set fso = Nothing
End Sub
Sub CreaTarea()
    Dim myItem As Object
    Set myItem = GetCurrentItem()
    If myItem.Class = olMail Then
        MakeTaskFromMail2 myItem
    End If
End Sub

'---------------------------------------------------------------------------------------
' Procedure : MakeTaskFromMail2
' DateTime :
' Author : Sue Mosher
' Purpose : Creea una tarea a apartir de un correo electrónico.
'---------------------------------------------------------------------------------------
'
Sub MakeTaskFromMail2(MyMail As Outlook.MailItem)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim objTask As Outlook.TaskItem

'Variables para recibir parámetros
Dim STR_MensajeTarea As String
Dim INT_Dias_Vence As Variant

'Carga el identificador del objeto para hacer referencia a el
strID = MyMail.EntryID

'Carga los datos del objeto
Set olNS = Application.GetNamespace("MAPI")
Set olMail = olNS.GetItemFromID(strID)

'Crea la nueva tarea
Set objTask = Application.CreateItem(olTaskItem)

'Pide el título de la tarea, por defecto se trae el Subject del Correo
STR_MensajeTarea = InputBox("Ingrese el título de la tarea", "Crear Tarea", olMail.Subject)

'Se pide el número de días en que vence la tarea. Si el parámetro no es número lo solicita nuevamente.
INT_Dias_Vence = 1
Do
INT_Dias_Vence = InputBox("Ingrese el # de días en que vence la tarea", "Crear Tarea", 1)
Loop Until IsNumeric(INT_Dias_Vence) = True

'Carga los datos de la Tarea
With objTask
'título de la tarea
.Subject = STR_MensajeTarea
'Fecha de Vencimiento (Fecha del correo + número de días de vencimiento)
.DueDate = DateAdd("d", INT_Dias_Vence, olMail.SentOn)
'texto del correo como texto de la tarea
.Body = olMail.Body
End With
'Copia los Adjuntos al mensaje Original
'Call CopyAttachments(olMail, objTask)

'Guarda los datos de la tarea
objTask.Save

'Libera los objetos de la memoria
Set objTask = Nothing
Set olMail = Nothing
Set olNS = Nothing
End Sub

'---------------------------------------------------------------------------------------
' Procedure : CopyAttachments
' DateTime :
' Author : Sue Mosher
' Purpose : Copia los adjuntos de un objeto a otro
'---------------------------------------------------------------------------------------
'
Sub CopyAttachments(objSourceItem, objTargetItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.FileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next

Set fldTemp = Nothing
Set fso = Nothing
End Sub

'---------------------------------------------------------------------------------------
' Procedure : CreaTarea
' DateTime :
' Author : Sue Mosher
' Purpose :
'---------------------------------------------------------------------------------------
'
Sub CreaTarea()
Dim myItem As Object

'Carga el objeto actual
Set myItem = GetCurrentItem()

'Válida que sea de tipo correo elctrónico
If myItem.Class = olMail Then
MakeTaskFromMail2 myItem
End If

End Sub

'---------------------------------------------------------------------------------------
' Procedure : GetCurrentItem
' DateTime :
' Author : Sue Mosher
' Purpose : Retorna el objeto de outlook actualmente activo
'---------------------------------------------------------------------------------------
'
Function GetCurrentItem() As Object
Dim objApp As Outlook.Application

Set objApp = CreateObject("Outlook.Application")

On Error Resume Next

Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
Case Else
' anything else will result in an error, which is
' why we have the error handler above
End Select

Set objApp = Nothing
End Function

Haz clic para expandir...

guille1 dijo:

#1 Copia de seguridad archivo .pst


Amigos:

tengo un problema en mi trabajo tengo cerca de 10 equipos a los que necesito realizar una copia del archivo pst de outlook 2003.Uso el programita de microsoft pdfbackup

Pero esta copia se guardaria en el servidor en una carpeta oculta con los permisos ntfs por usuario y por equipo.

Lo internto hacer de la siguiente manera.
la ruta es:
\\servidor\pst$\carpeta con nombre de usuario

pero cuando cierro el outlook y aparece el mensaje si deseo guardar la copia de seguridad le doy guardar pero dice que esta protegida contra escritura o que el disco esta lleno, pero ya defini los permisos en, seguridad y permisos

me podrian dar una solución

Haz clic para expandir...

c4rolit4 dijo:

NECESITO AYUDA...

depronto alguien pueda...

me enviaron un documento de word por el correo de outlook...
yo lo abri y trabajé sobre este documento...
guarde varias veces y en la ultima guardada el programa se bloqueo....
luego no encontré el archivo...

lo busque directamente en el mensaje que lo contenia pero por supuesto que no es...

me ayudan?

Haz clic para expandir...