none
Macro en Outlook 2016 NO se visualiza y NO se ejecuta RRS feed

  • Pregunta

  • Hola:

    Si alguien me pudiese ayudar/apoyar para la problematica que tengo:

    Estoy tratando de usar una macro para outlook 2016, la cual que consiste por medio del administrador de reglas y alertas

    ejecutar de una regla en la cual indico que cuando llegue un correo de una cuenta especifica al cualquier correo que descargue el archivo que este contenga (si contiene un archivo TXT que lo descargue a una carpeta C:\adjuntos\)

    En el editor de Visual Basic para aplicaciones quiero ejecutar la macro que esta visible, pero el listado de macros no me muestra ningun nombre (Proyecto1.SaveTXTAttachments).

    pero si lo puedo agregar el script a la regla (Primera imagen).

    Al hacer pruebas, la primera vez si funciono, pero de ahi ya no funciona.....He eliminado el archivo VBAProject.OTM y lo he vuelto a crea con el proceso de eliminar la regla, crearla y ni asi funciona.

    Realice las modificaciones en el Centro de Confianza de Outlook, ademas de revisar que el complemento VBA para Outlook estuviera activo.

    Este es mi codigo:

    Public Sub SaveTXTAttachments(objMsg As Outlook.MailItem)
    Dim objOL As Outlook.Application
    ' objMsg As Outlook.MailItem 'Object
    Dim objAttachments As Outlook.Attachments
    Dim objSelection As Outlook.Selection
    Dim i As Long
    Dim lngCount As Long
    Dim strFile As String
    Dim strFolderpath As String
    Dim strDeletedFiles As String
    Dim DateFormat

    ' Get the path to your My Documents folder
    strFolderpath = "C:\adjuntos\"
    On Error Resume Next

    ' Instantiate an Outlook Application object.
    Set objOL = CreateObject("Outlook.Application")

    ' Get the collection of selected objects.
    Set objSelection = objOL.ActiveExplorer.Selection

    ' The attachment folder needs to exist
    ' You can change this to another folder name of your choice

    ' Set the Attachment folder.
    strFolderpath = strFolderpath

    ' Check each selected item for attachments.
    For Each objMsg In objSelection

    Set objAttachments = objMsg.Attachments
    lngCount = objAttachments.Count

    If lngCount > 0 Then

    ' Use a count down loop for removing items
    ' from a collection. Otherwise, the loop counter gets
    ' confused and only every other item is removed.

    For i = lngCount To 1 Step -1

    ' Get the file name.
    strFile = objAttachments.Item(i).FileName
    DateFormat = Format(Now, "yyyy-mm-dd HH-mm-ss") & "." & Right(Format(Timer, "#0.00"), 2)
    ' Combine with the path to the Temp folder.
    'strFile = strFolderpath & strFile
    If InStr(strFile, ".txt") Then
        ' Save the attachment as a file.
        strFile = Left(strFile, InStr(strFile, ".") - 1)
        objAttachments.Item(i).SaveAsFile strFolderpath & strFile & "_" & DateFormat & ".txt"
    End If

    Next i
    End If

    Next

    ExitSub:

    Set objAttachments = Nothing
    Set objMsg = Nothing
    Set objSelection = Nothing
    Set objOL = Nothing
    End Sub

    Alguien me podria ayudar?

    En espera de comentarios.

    Saludos.


    LSC Ricardo Guerrero L. Puebla, Puebla Mexico

    lunes, 6 de noviembre de 2017 16:48

Todas las respuestas