Enviar mail por outlook 64 bit

Colapsar
X
 
  • Tiempo
  • Mostrar
Limpiar Todo
nuevos mensajes
  • ratadepantano
    Junior Member
    • abr
    • 11

    #1

    Enviar mail por outlook 64 bit

    Buen día atodos,

    En estos días, tuve un problema cuando se cambiaron todos los outlook 2007
    en las PCs e instalaron outlook 2010 64 bit porque la sentencia que todos conocemos para enviar mail a través de la "macro" de outlook no funciona para outlook 64bit

    CREATE OBJECT outlook 'Outlook.Application'. >>>no funciona para 64bit
    IF sy-subrc NE 0.
    EXIT.
    ENDIF.

    Encontré la solución , por eso les quiero dejar una función ABAP que envía los mail a través del outlook de 64 bit.
    Lo que hace esta función es crear un 'SCRIPT' (un bloque de sentencias) y descargarlo en la PC para luego ejecutarlos desde alli.

    >>>tener en cuenta
    APPEND 'myItem.Send' TO lt_vbs. >>>> esta sentencia nos indica que se ejecute el outlook automáticamente, sin tener que abrirlo
    * APPEND 'myItem.Display' TO t_vbs. >>> si descomentamos, y comentamos la linea anterior, nos abre el outlook en vez de enviarlo.
    >>>

    Saludos a todos y espero que le sea útil algún otro que tubo el mismo problema que el mio


    FUNCTION Z_OUTLOOK_MAIL_CREATE.
    *"----------------------------------------------------------------------
    *"*"Interfase local
    *" IMPORTING
    *" REFERENCE(I_SUBJECT) TYPE CHAR100
    *" REFERENCE(I_IMPORTANCIA) TYPE CHAR1 DEFAULT '0'
    *" TABLES
    *" T_EMAIL_BODY STRUCTURE SOLI
    *" T_EMAIL_ADDRESS STRUCTURE SOLI
    *" T_EMAIL_ATTACHMENTS STRUCTURE SOLI
    *" EXCEPTIONS
    *" INVALID_PATHNAME
    *" DOWNLOAD_FAILED
    *" EXECUTION_FAILED
    *"----------------------------------------------------------------------
    * *- Documentación.-
    * Mediante esta función podemos enviar a través del Outlook un mail
    * indicando el Asunto, Destinatarios, Cuerpo del mensaje, Archivos adj.
    * Tan solo es necesario pasar los parámetros que queramos y automát.
    * nos enviara los mensajes de Outlook con todos los datos rellenos

    * Global data declarations

    CONSTANTS:
    BEGIN OF con_hex,
    tab(2) TYPE c VALUE '09',
    END OF con_hex.

    DATA: lv_file type STRING,
    lv_RESULT type ABAP_BOOL,
    lv_translate type c LENGTH 2,
    lt_vbs type STANDARD TABLE OF soli,
    ls_vbs type soli,
    lv_last type xflag,
    lv_vbs_filename LIKE rlgrap-filename,
    lv_commandline type c LENGTH 1000,
    lv_APPLICATION type string,
    lv_PARAMETER type string,
    lv_subject type CHAR100,
    lv_imp type char1,
    lt_DATA_TAB type STANDARD TABLE OF SO_TEXT255,
    lv_FILETYPE type CHAR10,
    lv_FILENAME type STRING,
    lv_DAT_MODE type CHAR01.

    lv_subject = i_subject.
    lv_imp = I_IMPORTANCIA.

    *- Prepare a code to translate a quote into a hex-tab
    *- so it can then be translated back to 2 double quotes.
    CONCATENATE '"' con_hex-tab INTO lv_translate.

    APPEND: 'Dim myolapp ' TO lt_vbs,
    'Dim olNamespace ' TO lt_vbs,
    'Dim myItem ' TO lt_vbs,
    'Dim myRecipient ' TO lt_vbs,
    'Dim myAttachments ' TO lt_vbs,
    ' ' TO lt_vbs,
    'Set myolapp = CreateObject("Outlook.Application") ' TO lt_vbs,
    'Set olNamespace = myolapp.GetNamespace("MAPI") ' TO lt_vbs,
    'Set myItem = myolapp.CreateItem(olMailItem) ' TO lt_vbs,
    ' ' TO lt_vbs.

    *- Destinatarios del mensaje
    LOOP AT t_email_address.
    IF t_email_address = space.
    CONTINUE.
    ENDIF.
    CONCATENATE
    'Set myRecipient = myItem.Recipients.Add("' t_email_address '")'
    INTO ls_vbs.
    APPEND ls_vbs to lt_vbs.
    ENDLOOP.

    *- Asunto del mensaje
    IF sy-sysid = 'DSR' OR sy-sysid = 'QAS'.
    CONCATENATE 'myItem.Subject = "' '-' sy-sysid '-' lv_subject '"' INTO ls_vbs.
    APPEND ls_vbs to lt_vbs.

    ELSE.
    CONCATENATE 'myItem.Subject = "' lv_subject '"' INTO ls_vbs.
    APPEND ls_vbs to lt_vbs.
    ENDIF.

    *- Importancia >> 2
    CONCATENATE 'myItem.Importance = "' lv_imp '"' INTO ls_vbs.
    APPEND ls_vbs to lt_vbs.

    *- Ficheros adjuntos
    APPEND:
    'Set myAttachments = myItem.Attachments' TO lt_vbs.

    *- Chequeamos la existencia de los ficheros adjuntos
    LOOP AT t_email_attachments.
    lv_file = t_email_attachments-line.

    CLEAR lv_RESULT.
    CALL METHOD CL_GUI_FRONTEND_SERVICES=>FILE_EXIST
    EXPORTING
    FILE = lv_file
    RECEIVING
    RESULT = lv_RESULT
    EXCEPTIONS
    CNTL_ERROR = 1
    ERROR_NO_GUI = 2
    WRONG_PARAMETER = 3
    NOT_SUPPORTED_BY_GUI = 4
    others = 5.
    IF sy-subrc EQ 0 and lv_RESULT is NOT INITIAL.
    CONCATENATE 'myAttachments.Add("' t_email_attachments '")'
    INTO ls_vbs.
    APPEND ls_vbs to lt_vbs.
    ELSE.
    MESSAGE i000(38) WITH
    'No se ha podido adjuntar el fichero' t_email_attachments.
    ENDIF.
    ENDLOOP.

    *- Cuerpo del email
    CLEAR: lv_last, ls_vbs.
    APPEND ls_vbs to lt_vbs.
    LOOP AT t_email_body.
    AT FIRST.
    APPEND 'myitem.body = _' TO lt_vbs.
    ENDAT.
    AT LAST.
    lv_last = 'X'.
    ENDAT.

    *- Double-quotes(") will cause an error in VBScript
    *- Replace with a hex-tab and then replace with
    *- 2 double-quotes ("")
    TRANSLATE t_email_body USING lv_translate.
    WHILE sy-subrc EQ 0.
    REPLACE con_hex-tab WITH '""' INTO t_email_body.
    ENDWHILE.

    IF lv_last = 'X'.
    CONCATENATE '"' t_email_body '" &vbCrLf '
    INTO ls_vbs.
    ELSE.
    CONCATENATE '"' t_email_body '" &vbCrLf &_'
    INTO ls_vbs.
    ENDIF.
    APPEND ls_vbs to lt_vbs.
    ENDLOOP.

    * APPEND 'myItem.Display' TO t_vbs.
    APPEND 'myItem.Send' TO lt_vbs.

    * -- Posibilidad de mostrar un MsgBox al abrir el Outlook
    * APPEND 'Dim myVar' TO t_vbs.
    * DATA: aux(255).
    * aux = 'Aquí podemos poner el mensaje que queramos'.
    * CONCATENATE 'myVar = MsgBox ("' aux '", 0, "Advertencia")' INTO aux.
    * APPEND aux TO t_vbs.

    *- Preparamos el nombre de fichero vbscript para descargarlo
    *- y ejecutarlo, llamando a la variable de entorno de Windows
    *- TEMP
    CLEAR lv_vbs_filename.
    CALL FUNCTION 'WS_QUERY'
    EXPORTING
    environment = 'TEMP'
    query = 'EN'
    IMPORTING
    return = lv_vbs_filename
    EXCEPTIONS
    inv_query = 1
    no_batch = 2
    frontend_error = 3
    OTHERS = 4.
    IF sy-subrc > 0.
    RAISE invalid_pathname.

    ENDIF.

    CONCATENATE lv_vbs_filename 'mail.vbs' INTO lv_vbs_filename.
    lv_commandline = lv_vbs_filename.

    PERFORM sapgui_progress(rstxldmc) USING 10
    'Realizando download de fichero...'.

    *- Descargamos el fichero vbscript
    lv_FILENAME = lv_vbs_filename.
    lv_FILETYPE = 'DAT'.
    lv_DAT_MODE = 'S'.
    lt_DATA_TAB[] = lt_vbs[].

    CALL METHOD CL_GUI_FRONTEND_SERVICES=>GUI_DOWNLOAD
    EXPORTING
    FILENAME = lv_FILENAME
    FILETYPE = lv_FILETYPE "'DAT'
    DAT_MODE = lv_DAT_MODE "'S'
    CHANGING
    DATA_TAB = lt_DATA_TAB
    EXCEPTIONS
    FILE_WRITE_ERROR = 1
    NO_BATCH = 2
    GUI_REFUSE_FILETRANSFER = 3
    INVALID_TYPE = 4
    NO_AUTHORITY = 5
    UNKNOWN_ERROR = 6
    HEADER_NOT_ALLOWED = 7
    SEPARATOR_NOT_ALLOWED = 8
    FILESIZE_NOT_ALLOWED = 9
    HEADER_TOO_LONG = 10
    DP_ERROR_CREATE = 11
    DP_ERROR_SEND = 12
    DP_ERROR_WRITE = 13
    UNKNOWN_DP_ERROR = 14
    ACCESS_DENIED = 15
    DP_OUT_OF_MEMORY = 16
    DISK_FULL = 17
    DP_TIMEOUT = 18
    FILE_NOT_FOUND = 19
    DATAPROVIDER_EXCEPTION = 20
    CONTROL_FLUSH_ERROR = 21
    NOT_SUPPORTED_BY_GUI = 22
    ERROR_NO_GUI = 23
    others = 24.
    IF SY-SUBRC <> 0.
    RAISE download_failed.

    ENDIF.

    * Abrimos el Outlook
    PERFORM sapgui_progress(rstxldmc) USING 50
    'Abriendo Outlook... Espere por favor'.

    lv_APPLICATION = lv_commandline.
    lv_PARAMETER = 'WSCRIPT.EXE'.

    CALL METHOD CL_GUI_FRONTEND_SERVICES=>EXECUTE
    EXPORTING
    APPLICATION = lv_APPLICATION
    PARAMETER = lv_PARAMETER
    EXCEPTIONS
    CNTL_ERROR = 1
    ERROR_NO_GUI = 2
    BAD_PARAMETER = 3
    FILE_NOT_FOUND = 4
    PATH_NOT_FOUND = 5
    FILE_EXTENSION_UNKNOWN = 6
    ERROR_EXECUTE_FAILED = 7
    SYNCHRONOUS_FAILED = 8
    NOT_SUPPORTED_BY_GUI = 9
    others = 10.
    IF SY-SUBRC <> 0.
    RAISE execution_failed.

    ENDIF.
    * MESSAGE s000(38) WITH 'Abriendo Outlook... Espere por favor'.


    ENDFUNCTION.
    Archivos Adjuntos
    Editado por última vez por ratadepantano; 02/11/2016, 12:08:43.
Trabajando...