MUNDOSAP

Regresar   MUNDOSAP > DESARROLLO > Programación ABAP IV
Nombre de Usuario
Contraseña
Home Descargas Registrar FAQ Miembros Calendario Buscar Temas de Hoy Marcar Foros Como Leídos




 
Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Viejo 02/11/16, 12: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 13:08:43.
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Reglas de Mensajes
no puedes crear nuevos temas
no puedes responder temas
no puedes adjuntar archivos
no puedes editar tus mensajes

El código vB está On
Las caritas están On
Código [IMG] está On
Código HTML está Off
Saltar a Foro


Husos Horarios son GMT. La hora en este momento es 14:46:32.


www.mundosap.com 2006 - Spain
software crm, crm on demand, software call center, crm act, crm solutions, crm gratis, crm web