SAP R/3 форум ABAP консультантов

[admin]

FUNCTION z_jb_ux_sendmail.
*"----------------------------------------------------------------------
*"*"Lokale Schnittstelle:
*" IMPORTING
*" VALUE(TO) LIKE SOMLRECI1-RECEIVER
*" VALUE(FROM) LIKE SXRECINFI1-SENDER OPTIONAL
*" VALUE(SENDER) LIKE SXRECINFI1-SND_VINAME OPTIONAL
*" VALUE(SUBJECT) LIKE SODOCCHGI1-OBJ_DESCR OPTIONAL
*" VALUE(XHTML) LIKE SY-BATCH DEFAULT 'X'
*" TABLES
*" I_CONT STRUCTURE SOLISTI1
*" EXCEPTIONS
*" ERROR
*"----------------------------------------------------------------------

DATA: BEGIN OF ergtab OCCURS 0,
line(250) TYPE c,
END OF ergtab.

DATA:
i_head1 LIKE solisti1 OCCURS 0 WITH HEADER LINE,
i_head2 LIKE solisti1 OCCURS 0 WITH HEADER LINE,
i_head3 LIKE solisti1 OCCURS 0 WITH HEADER LINE,
prot_path LIKE rlgrap-filename,
datnam LIKE rlgrap-filename,
rcode LIKE inri-returncode,
ind LIKE sy-tabix,
len LIKE sy-tabix,
zeich LIKE sy-batch,
mailn(10) TYPE n,
line(2000) TYPE c,
com(250) TYPE c.

* ggf. Email-Adresse des angemeldeten User bestimmen
IF from IS INITIAL.
SELECT SINGLE * FROM usr21 WHERE bname = sy-uname.
SELECT date_from smtp_addr
INTO (adr6-date_from, from)
FROM adr6
WHERE addrnumber = usr21-addrnumber
AND persnumber = usr21-persnumber
AND date_from <= sy-datum
ORDER BY date_from.
IF from CA '@'. EXIT. ENDIF.
ENDSELECT.
IF sy-subrc <> 0 OR from NA '@'.
MESSAGE e999(zj) WITH 'Kein Empfдnger angegeben.' RAISING error.
ENDIF.
ENDIF.

* Email-Header aufbauen
i_head1 = 'Return-path: $'.
displace i_head1 '$' from.
APPEND i_head1.
IF NOT sender IS INITIAL.
i_head1 = 'From: "$" <$>'.
displace i_head1 '$' sender.
displace i_head1 '$' from.
ELSE.
i_head1 = 'From: <$>'.
displace i_head1 '$' from.
ENDIF.
APPEND i_head1.
i_head1 = 'To: $'.
displace i_head1 '$' to.
APPEND i_head1.
i_head1 = 'Subject: $'.
displace i_head1 '$' subject.
APPEND i_head1.
i_head1 = 'MIME-Version: 1.0'.
APPEND i_head1.
IF xhtml = ''.
i_head1 = 'Content-Type: text/plain;'.
APPEND i_head1.
i_head1 = ' charset="iso-8859-1"'.
APPEND i_head1.
i_head1 = 'Content-Transfer-Encoding: quoted-printable'.
APPEND i_head1.
i_head1 = ''.
APPEND i_head1.
ELSE.
i_head1 = 'Content-Type: multipart/alternative;'.
APPEND i_head1.
i_head1 = ' boundary="----_=_NextPart_001_01C31ECC.DFEA6CF0"'.
APPEND i_head1.
i_head1 = ''.
APPEND i_head1.
i_head1 = '------_=_NextPart_001_01C31ECC.DFEA6CF0'.
APPEND i_head1.
i_head1 = 'Content-Type: text/plain;'.
APPEND i_head1.
i_head1 = ' charset="iso-8859-1"'.
APPEND i_head1.
i_head1 = 'Content-Transfer-Encoding: quoted-printable'.
APPEND i_head1.
i_head1 = ''.
APPEND i_head1.
i_head2 = '------_=_NextPart_001_01C31ECC.DFEA6CF0'.
APPEND i_head2.
i_head2 = 'Content-Type: text/html;'.
APPEND i_head2.
i_head2 = ' charset="iso-8859-1"'.
APPEND i_head2.
i_head2 = 'Content-Transfer-Encoding: quoted-printable'.
APPEND i_head2.
i_head2 = ''.
APPEND i_head2.
i_head2 = ''.
APPEND i_head2.
i_head2 = ''.
APPEND i_head2.
i_head2 = '
'.
APPEND i_head2.
i_head3 = '

'.
APPEND i_head3.
i_head3 = '------_=_NextPart_001_01C31ECC.DFEA6CF0--'.
APPEND i_head3.
ENDIF.

* nдchste Mail-Nummer bestimmen
CALL FUNCTION 'NUMBER_GET_NEXT'
EXPORTING
nr_range_nr = '01'
object = 'ZJBSNDMAIL'
IMPORTING
number = mailn
returncode = rcode
EXCEPTIONS
interval_not_found = 1
number_range_not_intern = 2
object_not_found = 3
quantity_is_0 = 4
quantity_is_not_1 = 5
interval_overflow = 6
buffer_overflow = 7
OTHERS = 8.
IF rcode <> 0 OR sy-subrc <> 0.
MESSAGE e999(zj) WITH 'Fehler beim Bestimmen der Mail-Nummer.'
RAISING error.
ENDIF.

* Dateinamen fьr Mail bestimmen
CALL FUNCTION 'FILE_GET_NAME'
EXPORTING
logical_filename = 'Z_IS_ZVA'
parameter_1 = '/prot/'
IMPORTING
file_name = prot_path
EXCEPTIONS
file_not_found = 1
OTHERS = 2.
CONCATENATE prot_path 'mail_' mailn '.dat' INTO datnam.

* Mail-Datei schreiben
OPEN DATASET datnam FOR OUTPUT IN TEXT MODE.
IF sy-subrc <> 0.
MESSAGE e999(zj) WITH 'Maildatei konnte nicht geschrieben werden.'
RAISING error.
ENDIF.
IF xhtml = ''.
* .. nur Plaintext
LOOP AT i_head1.
TRANSFER i_head1 TO datnam.
ENDLOOP.
LOOP AT i_cont.
TRANSFER i_cont TO datnam.
ENDLOOP.
ELSE.
* .. Multipart (Plaintext und HTML)
LOOP AT i_head1.
TRANSFER i_head1 TO datnam.
ENDLOOP.
LOOP AT i_cont.
TRANSFER i_cont TO datnam.
ENDLOOP.
LOOP AT i_head2.
TRANSFER i_head2 TO datnam.
ENDLOOP.
LOOP AT i_cont.
CLEAR line.
len = strlen( i_cont ).
DO len TIMES.
ind = sy-index - 1.
zeich = i_cont+ind(1).
IF zeich <> ''.
CONCATENATE line zeich INTO line.
ELSE.
CONCATENATE line ' ' INTO line.
ENDIF.
ENDDO.
CONCATENATE line '
' INTO LINE.
TRANSFER line TO datnam.
ENDLOOP.
LOOP AT i_head3.
TRANSFER i_head3 TO datnam.
ENDLOOP.
ENDIF.
CLOSE DATASET datnam.

* Mail versenden
com = 'mail $ < $ 2>&1'.
displace com '$' to.
displace com '$' datnam.
CALL 'SYSTEM' ID 'COMMAND' FIELD com
ID 'TAB' FIELD ergtab[].

IF NOT ergtab[] IS INITIAL.
MESSAGE e999(zj) WITH 'Es ist ein Fehler beim Versenden des Mails'
'aufgetreten.' RAISING error.
ENDIF.

ENDFUNCTION.