***********************************************************************
* System name : MM *
* Subsystem name : REPORT *
* Program name : PO 未發送供應商郵件提醒 *
* Creation user : WILLIE *
* Creation date : 2020.04.27 *
* Screen /STATUS : STATUS1 *
***********************************************************************
* REVISION LOG *
* LOG# DATE AUTHOR DESCRIPTION *
* ---- ------- ------ -------------- *
* 01 20200427 WILLIE CREATE *
***********************************************************************
REPORT ZMM_PO_REMIND.
TYPE-POOLS:SLIS.
TABLES: EKKO,ZMM27_MAILSEND,VTBBEWE,ZMM27_MAILDATE.
DATA : GT_FIELDCAT TYPE SLIS_T_FIELDCAT_ALV.
DATA : GS_LAYOUT TYPE SLIS_LAYOUT_ALV,
G_REPID LIKE SY-REPID .
DATA: BEGIN OF GT_DATA OCCURS 0,
EBELN LIKE CDPOS-OBJECTID,
CHANGENR LIKE CDPOS-CHANGENR,
AEDAT LIKE EKKO-AEDAT,
UDATE LIKE CDHDR-UDATE,
FRGKE LIKE EKKO-FRGKE,
ERNAM LIKE EKKO-ERNAM,
ZFLAG1 LIKE ZMM27_MAILSEND-ZFLAG1,
ZDATE TYPE INT4, "當前日期與批准日期差
END OF GT_DATA.
DATA: GT_SEND LIKE TABLE OF GT_DATA WITH HEADER LINE.
DATA: GT_ERNAM LIKE TABLE OF GT_DATA WITH HEADER LINE.
DATA: WA_MAILDATE TYPE ZMM27_MAILDATE. "added by willie 2020.05.12
DATA: BEGIN OF GT_CDPOS OCCURS 0,
OBJECTID LIKE CDPOS-OBJECTID,
CHANGENR LIKE CDPOS-CHANGENR,
END OF GT_CDPOS.
DATA: BEGIN OF GT_CDHDR OCCURS 0,
OBJECTID LIKE CDHDR-OBJECTID,
CHANGENR LIKE CDHDR-CHANGENR,
UDATE LIKE CDHDR-UDATE,
END OF GT_CDHDR.
DEFINE HEAD.
FIELDCAT-FIELDNAME = &1.
FIELDCAT-REPTEXT_DDIC = &2.
FIELDCAT-COL_POS = &3.
FIELDCAT-REF_FIELDNAME = &4.
FIELDCAT-REF_TABNAME = &5.
FIELDCAT-HOTSPOT = &6.
FIELDCAT-ICON = &7.
APPEND FIELDCAT TO P_FIELDCAT.
CLEAR: FIELDCAT.
END-OF-DEFINITION.
*--------------------------------------------------------------------*
* SELECTION-SCREEN
*--------------------------------------------------------------------*
SELECTION-SCREEN BEGIN OF BLOCK BLOCK1 WITH FRAME TITLE TEXT-T01.
SELECT-OPTIONS: S_EBELN FOR EKKO-EBELN.
SELECT-OPTIONS: S_AEDAT FOR EKKO-AEDAT.
SELECT-OPTIONS: S_ERNAM FOR EKKO-ERNAM NO INTERVALS.
PARAMETERS: P_SEND LIKE ZMM27_MAILSEND-ZFLAG1.
SELECT-OPTIONS: S_ZDATE FOR VTBBEWE-ATAGE.
SELECTION-SCREEN END OF BLOCK BLOCK1.
SELECTION-SCREEN BEGIN OF BLOCK BLOCK2 WITH FRAME TITLE TEXT-T02.
PARAMETERS: P_MODEL TYPE C AS CHECKBOX.
SELECTION-SCREEN END OF BLOCK BLOCK2.
*&---------------------------------------------------------------------*
* INITIALIZATION.
*----------------------------------------------------------------------*
INITIALIZATION.
P_SEND = 'N'.
S_ZDATE-SIGN = 'I'.
S_ZDATE-OPTION = 'BT'.
S_ZDATE-LOW = '6'.
S_ZDATE-HIGH = '9999'.
APPEND S_ZDATE.
*-----------------------------------------------------------------------
* START-OF-SELECTION
*-----------------------------------------------------------------------
START-OF-SELECTION.
PERFORM GET_DATA.
IF P_MODEL EQ 'X'.
PERFORM EMAI_PO.
ENDIF.
PERFORM PRT_DATA.
*&---------------------------------------------------------------------*
*& Form GET_DATA
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM GET_DATA .
DATA: GT_LINES TYPE INT4.
DATA: PO_MIN LIKE EKKO-EBELN.
"郵件地址基準日期 "added by willie 2020.05.12
SELECT SINGLE *
INTO WA_MAILDATE
FROM ZMM27_MAILDATE
.
SELECT A~EBELN
A~AEDAT
A~FRGKE
A~ERNAM
B~ZFLAG1
INTO CORRESPONDING FIELDS OF TABLE GT_DATA
FROM EKKO AS A LEFT JOIN ZMM27_MAILSEND AS B
ON A~EBELN EQ B~EBELN
WHERE A~EBELN IN S_EBELN
AND A~AEDAT IN S_AEDAT
AND A~ERNAM IN S_ERNAM
AND A~LOEKZ NE 'L'
AND A~FRGKE EQ '1'
AND A~LIFNR NOT LIKE '00008%' "Added by Willie 2020.05.11
.
DESCRIBE TABLE GT_DATA LINES GT_LINES.
IF GT_LINES EQ 0.
MESSAGE '無滿足查詢條件的數據' TYPE 'E'.
ENDIF.
"PO審批記錄
SELECT A~OBJECTID
A~CHANGENR
FROM CDPOS AS A INTO CORRESPONDING FIELDS OF TABLE GT_CDPOS
FOR ALL ENTRIES IN GT_DATA
WHERE A~OBJECTID EQ GT_DATA-EBELN
AND A~OBJECTCLAS EQ 'EINKBELEG'
AND A~TABNAME EQ 'EKKO'
AND A~FNAME EQ 'FRGKE'
AND A~VALUE_NEW EQ '1'
.
SORT GT_CDPOS BY OBJECTID CHANGENR DESCENDING. "降序，將CHANGENR最新的排前
"獲取審批記錄中最新一條文檔編號
FIELD-SYMBOLS: <FS_DATA> LIKE LINE OF GT_DATA.
LOOP AT GT_DATA ASSIGNING <FS_DATA> .
READ TABLE GT_CDPOS WITH KEY OBJECTID = <FS_DATA>-EBELN BINARY SEARCH.
IF SY-SUBRC = 0.
<FS_DATA>-CHANGENR = GT_CDPOS-CHANGENR.
ENDIF.
ENDLOOP.
"PO審批日期
SELECT A~OBJECTID
A~CHANGENR
A~UDATE
FROM CDHDR AS A
INTO CORRESPONDING FIELDS OF TABLE GT_CDHDR
FOR ALL ENTRIES IN GT_DATA
WHERE A~OBJECTID EQ GT_DATA-EBELN
AND A~CHANGENR EQ GT_DATA-CHANGENR
AND A~OBJECTCLAS EQ 'EINKBELEG'
.
SORT GT_CDHDR BY OBJECTID CHANGENR DESCENDING.
FIELD-SYMBOLS: <FS_TAB> LIKE LINE OF GT_DATA.
LOOP AT GT_DATA ASSIGNING <FS_TAB> .
READ TABLE GT_CDHDR WITH KEY OBJECTID = <FS_TAB>-EBELN
CHANGENR = <FS_TAB>-CHANGENR
BINARY SEARCH.
IF SY-SUBRC = 0.
<FS_TAB>-UDATE = GT_CDHDR-UDATE.
CALL FUNCTION 'FIMA_DAYS_AND_MONTHS_AND_YEARS'
EXPORTING
I_DATE_FROM = <FS_TAB>-UDATE
I_DATE_TO = SY-DATUM
IMPORTING
E_DAYS = <FS_TAB>-ZDATE.
ELSE.
CALL FUNCTION 'FIMA_DAYS_AND_MONTHS_AND_YEARS'
EXPORTING
I_DATE_FROM = <FS_TAB>-AEDAT
I_DATE_TO = SY-DATUM
IMPORTING
E_DAYS = <FS_TAB>-ZDATE.
ENDIF.
ENDLOOP.
IF P_SEND EQ 'Y'.
DELETE GT_DATA WHERE ( ZFLAG1 NE 'Y' AND UDATE GT WA_MAILDATE-ZBSDT ).
ELSEIF P_SEND EQ 'N'.
DELETE GT_DATA WHERE ZFLAG1 EQ 'Y'
OR UDATE LE WA_MAILDATE-ZBSDT.
ENDIF.
IF S_ZDATE IS NOT INITIAL.
DELETE GT_DATA WHERE ZDATE NOT BETWEEN S_ZDATE-LOW AND S_ZDATE-HIGH.
ENDIF.
GT_ERNAM[] = GT_DATA[].
SORT GT_ERNAM BY ERNAM.
DELETE ADJACENT DUPLICATES FROM GT_ERNAM COMPARING ERNAM.
SORT GT_DATA BY ZDATE.
ENDFORM. " GET_DATA
*&---------------------------------------------------------------------*
*& Form USER_COMMAND
*&---------------------------------------------------------------------*
* Status bar Buttons
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM USER_COMMAND USING R_UCOMM LIKE SY-UCOMM
RS_SELFIELD TYPE SLIS_SELFIELD.
CASE R_UCOMM.
WHEN 'EXIT'.
LEAVE TO SCREEN 0 .
WHEN 'EMAIL'.
PERFORM EMAI_PO.
ENDCASE.
ENDFORM. "user_command
*&---------------------------------------------------------------------*
*& Form FRM_STATUS_SET
*&---------------------------------------------------------------------*
* Status Bar Write
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM STATUS_SET USING RT_EXTAB TYPE SLIS_T_EXTAB. "#EC *
SET PF-STATUS 'STATUS1'.
ENDFORM. "f01_alv_event_pf_status_set
*&---------------------------------------------------------------------*
*& Form PRT_DATA
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM PRT_DATA .
*定義輸出報表表頭
PERFORM FIELDCAT_INIT_DETAILS USING GT_FIELDCAT[].
PERFORM LAYOUT_BUILD CHANGING G_REPID
GS_LAYOUT.
*ALV輸出
CALL FUNCTION 'REUSE_ALV_GRID_DISPLAY'
EXPORTING
I_BYPASSING_BUFFER = 'X'
I_BUFFER_ACTIVE = 'X'
I_CALLBACK_PROGRAM = G_REPID
I_CALLBACK_PF_STATUS_SET = 'STATUS_SET'
I_CALLBACK_USER_COMMAND = 'USER_COMMAND'
IS_LAYOUT = GS_LAYOUT
IT_FIELDCAT = GT_FIELDCAT[]
TABLES
T_OUTTAB = GT_DATA[].
ENDFORM. " PRT_DATA
*&---------------------------------------------------------------------*
*& Form FIELDCAT_INIT_DETAILS
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_GT_FIELDCAT[] text
*----------------------------------------------------------------------*
FORM FIELDCAT_INIT_DETAILS USING P_FIELDCAT TYPE SLIS_T_FIELDCAT_ALV.
DATA: FIELDCAT TYPE SLIS_FIELDCAT_ALV.
HEAD 'EBELN' '採購憑證號' '11' 'EBELN' 'EKKO' '' ''.
HEAD 'CHANGENR' '更改編號' '10' 'CHANGENR' 'CDPOS' '' ''.
HEAD 'UDATE' '最後審覈日期' '8' 'UDATE' 'CDHDR' '' ''.
HEAD 'FRGKE' '審覈狀態' '1' 'FRGKE' 'EKKO' '' ''.
HEAD 'AEDAT' '創建日期' '8' 'AEDAT' 'EKKO' '' ''.
HEAD 'ERNAM' '申請人' '17' 'ERNAM' 'EKKO' '' ''.
HEAD 'ZFLAG1' '發送標識' '1' 'ZFLAG1' 'ZMM27_MAILSEND' '' ''.
HEAD 'ZDATE' '間隔日期' '5' '' '' '' ''.
ENDFORM. " FIELDCAT_INIT_DETAILS
*&---------------------------------------------------------------------*
*& Form LAYOUT_BUILD
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* <--P_G_REPID text
* <--P_GS_LAYOUT text
*----------------------------------------------------------------------*
FORM LAYOUT_BUILD CHANGING T_REPID LIKE SY-REPID
TS_LAYOUT TYPE SLIS_LAYOUT_ALV.
T_REPID = SY-REPID. "程序爲當前程序
TS_LAYOUT-ZEBRA = 'X'.
TS_LAYOUT-DETAIL_POPUP = 'X'. "是否彈出詳細信息窗口
TS_LAYOUT-COLWIDTH_OPTIMIZE = 'X'. "優化列寬選項是否設置
TS_LAYOUT-DETAIL_INITIAL_LINES = 'X'.
ENDFORM. "LAYOUT_BUILD
*&---------------------------------------------------------------------*
*& Form EMAI_PO
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM EMAI_PO .
* Internal Table declarations
DATA: I_RECEIVERS TYPE TABLE OF SOMLRECI1 WITH HEADER LINE,
* Objects to send mail.
I_OBJPACK LIKE SOPCKLSTI1 OCCURS 0 WITH HEADER LINE,
I_OBJTXT LIKE SOLISTI1 OCCURS 0 WITH HEADER LINE,
I_OBJBIN LIKE SOLISTI1 OCCURS 0 WITH HEADER LINE,
I_RECLIST LIKE SOMLRECI1 OCCURS 0 WITH HEADER LINE,
* Work Area declarations
WA_OBJHEAD TYPE SOLI_TAB,
WA_DOC_CHNG TYPE SODOCCHGI1.
DATA:LT_OBJECT_ID LIKE SOFOLENTI1-OBJECT_ID.
DATA: L_MSG TYPE STRING.
DATA: V_LINES_TXT TYPE I.
DATA: L_SENDER TYPE SO_REC_EXT.
DATA: ST_CONTENTS TYPE SOLISTI1 OCCURS 0 WITH HEADER LINE.
DATA: L_WARN TYPE SOLISTI1.
DATA: I_SENDER TYPE AD_SMTPADR,
I_CCNAM TYPE AD_SMTPADR,
I_TONAM TYPE AD_SMTPADR.
LOOP AT GT_ERNAM.
REFRESH: I_RECLIST,I_OBJTXT,
I_OBJBIN,I_OBJPACK.
REFRESH: GT_SEND,ST_CONTENTS.
CLEAR:L_WARN.
GT_SEND[] = GT_DATA[].
DELETE GT_SEND WHERE ERNAM NE GT_ERNAM-ERNAM.
IF GT_SEND[] IS INITIAL.
CONTINUE.
ENDIF.
"CC
SELECT SINGLE EMAIL INTO I_CCNAM
FROM ZMM27_MAILADR
WHERE MTYPE EQ 'MH'.
"SENDER
SELECT SINGLE EMAIL INTO I_SENDER
FROM ZMM27_MAILADR
WHERE VERKF EQ GT_ERNAM-ERNAM
AND MTYPE EQ 'ME'.
IF SY-SUBRC NE 0.
MOVE I_CCNAM TO I_SENDER.
CONCATENATE '<font color="red">Warning: The email address of  '
GT_ERNAM-ERNAM
'  is not maintained!'
INTO L_WARN.
ENDIF.
I_TONAM = I_SENDER.
CONCATENATE I_SENDER '@unisoc.com'
INTO L_SENDER.
LOOP AT GT_SEND.
CONCATENATE
`<tr> <td width=150>` GT_SEND-EBELN
`</td><td width=150>` GT_SEND-AEDAT+0(4) '-' GT_SEND-AEDAT+4(2) '-' GT_SEND-AEDAT+6(2)
`</td><td width=150>` GT_SEND-ERNAM
`</td></tr>`
INTO ST_CONTENTS .
APPEND ST_CONTENTS.
ENDLOOP.
APPEND `<HTML> <font face="verdana" color="Black"> <BODY> Dear,` TO I_OBJTXT.
APPEND `<blockquote><font face="verdana">The following PO you created has not been emailed to the supplier,` TO I_OBJTXT.
APPEND `<meta http-equiv=Content-Type content` TO I_OBJTXT.
APPEND `="text/html; charset=utf-8">` TO I_OBJTXT.
APPEND `<p><TABLE border=1 width= 450 ` TO I_OBJTXT.
APPEND `style='border-collapse:collapse;font-size:11pt;color:#000000'>` TO I_OBJTXT.
APPEND `<TR style= 'background:#920784'> ` TO I_OBJTXT.
APPEND `<Th>採購訂單</Th>` TO I_OBJTXT.
APPEND `<Th>創建日期</Th>` TO I_OBJTXT.
APPEND `<Th>創建人</Th>` TO I_OBJTXT.
APPEND `</TR><center>` TO I_OBJTXT.
APPEND LINES OF ST_CONTENTS TO I_OBJTXT.
APPEND '</center></TABLE></p>' TO I_OBJTXT.
IF L_WARN IS NOT INITIAL.
APPEND L_WARN TO I_OBJTXT.
ENDIF.
APPEND '<p><font face="verdana" color="Black">Pls kindly check.' TO I_OBJTXT.
APPEND '<br />Thank you!</p></blockquote>' TO I_OBJTXT.
APPEND INITIAL LINE TO I_OBJTXT.
APPEND '</BODY> </HTML>' TO I_OBJTXT.
DESCRIBE TABLE I_OBJTXT LINES V_LINES_TXT.
READ TABLE I_OBJTXT INDEX V_LINES_TXT.
WA_DOC_CHNG-OBJ_NAME = 'SEND Email'.
WA_DOC_CHNG-EXPIRY_DAT = SY-DATUM + 2.
WA_DOC_CHNG-OBJ_DESCR = 'PO未發郵件提醒'.
WA_DOC_CHNG-SENSITIVTY = 'F'.
WA_DOC_CHNG-DOC_SIZE = V_LINES_TXT * 255.
I_OBJPACK-TRANSF_BIN = SPACE.
I_OBJPACK-HEAD_START = 1.
I_OBJPACK-HEAD_NUM = 0.
I_OBJPACK-BODY_START = 1.
DESCRIBE TABLE I_OBJTXT LINES I_OBJPACK-BODY_NUM.
I_OBJPACK-DOC_TYPE = 'HTML'.
APPEND I_OBJPACK.
"TO
CLEAR I_RECLIST.
CONCATENATE I_TONAM '@unisoc.com'
INTO I_RECLIST-RECEIVER.
I_RECLIST-REC_TYPE = 'U'.
APPEND I_RECLIST.CLEAR I_RECLIST.
"CC
CLEAR I_RECLIST.
CONCATENATE I_CCNAM '@unisoc.com'
INTO I_RECLIST-RECEIVER.
I_RECLIST-COPY = 'X'.
I_RECLIST-REC_TYPE = 'U'.
APPEND I_RECLIST.CLEAR I_RECLIST.
CALL FUNCTION 'SO_DOCUMENT_SEND_API1'
EXPORTING
DOCUMENT_DATA = WA_DOC_CHNG
PUT_IN_OUTBOX = 'X'
SENDER_ADDRESS = L_SENDER
SENDER_ADDRESS_TYPE = 'SMTP'
COMMIT_WORK = 'X'
IMPORTING
NEW_OBJECT_ID = LT_OBJECT_ID
TABLES
PACKING_LIST = I_OBJPACK
OBJECT_HEADER = WA_OBJHEAD
CONTENTS_BIN = I_OBJBIN
CONTENTS_TXT = I_OBJTXT
RECEIVERS = I_RECLIST
EXCEPTIONS
TOO_MANY_RECEIVERS = 1
DOCUMENT_NOT_SENT = 2
DOCUMENT_TYPE_NOT_EXIST = 3
OPERATION_NO_AUTHORIZATION = 4
PARAMETER_ERROR = 5
X_ERROR = 6
ENQUEUE_ERROR = 7
OTHERS = 8.
IF SY-SUBRC <> 0.
MESSAGE ID SY-MSGID TYPE SY-MSGTY NUMBER SY-MSGNO
WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
ELSE.
MOVE '郵件已送至發送隊列！' TO L_MSG.
ENDIF.
ENDLOOP.
IF L_MSG IS NOT INITIAL.
MESSAGE L_MSG TYPE 'S'.
ENDIF.
ENDFORM. " EMAI_PO
注意：通過以上代碼即可將使用HTML設計好的郵件送到SAP郵件發送隊列。後續只需要basis配置好STMP郵件發送功能即可定時推送出郵件隊列中的待發郵件。