Ver Mensaje Individual
  #1  
Viejo 02/11/16, 11:53:03
ratadepantano ratadepantano is offline
Junior Member
 
Fecha de Ingreso: abr 2011
Mensajes: 11
Enviar mail a través de cuenta outlook 64 bit desde SAP

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
Tipo de Archivo: zip z_outlook_mail_create.zip (5.2 KB, 9 visitas)

Úlima edición por ratadepantano fecha: 02/11/16 a las 12:08:43.
Responder Con Cita