*......................................................................*
*: Report  ZSAPTALK                                                   :*
*: Author  SAPdev.co.uk                                               :*
*:.....................................................................*
*: Description :                                                      :*
*:.............:                                                      :*
*: Send mail message to SAP mail inbox.                               :*
*:                                                                    :*
*:                     Please visit www.sapdev.co.uk for further info :*
*:....................................................................:*
REPORT ZSAPMAIL NO STANDARD PAGE HEADING.

TABLES: DRAD,
        QINF,
        DRAW,
        SOUC,
        SOFD,
        DRAP.

DATA: P_RETURN_CODE LIKE SY-SUBRC.

data: d_username LIKE DRAP-PRNAM.

* mail declarations
DATA : BEGIN OF NEW_OBJECT_ID.         " the newly created email object
        INCLUDE STRUCTURE SOODK.
DATA : END OF NEW_OBJECT_ID.

DATA : BEGIN OF FOLDER_ID.             " the folder id of the outbox
        INCLUDE STRUCTURE SOODK.
DATA : END OF FOLDER_ID.

DATA : BEGIN OF REC_TAB OCCURS 5.     " the table which will contain the
        INCLUDE STRUCTURE SOOS1.       " information on the destination
DATA : END OF REC_TAB.

DATA : BEGIN OF OBJECT_HD_CHANGE.      " the table which contains the
        INCLUDE STRUCTURE SOOD1.       " info for the object we will be
DATA : END OF OBJECT_HD_CHANGE.        " creating

DATA : OBJECT_TYPE LIKE SOOD-OBJTP.    " the type of object

DATA : BEGIN OF OBJHEAD OCCURS 5.      " the header of the object
        INCLUDE STRUCTURE SOLI.
DATA : END OF OBJHEAD.

DATA : BEGIN OF OBJCONT OCCURS 0.      " the contents of the object
        INCLUDE STRUCTURE SOLI.        " i.e. the text etc
DATA : END OF OBJCONT.

DATA : BEGIN OF OBJPARA OCCURS 5.      " formatting options
        INCLUDE STRUCTURE SELC.
DATA : END OF OBJPARA.

DATA : BEGIN OF OBJPARB OCCURS 5.      " formatting options
        INCLUDE STRUCTURE SOOP1.
DATA : END OF OBJPARB.

DATA : BEGIN OF T_MAIL_TEXT OCCURS 0,  "Message table for messages to
        STRING(255),                   "user via mailbox
       END OF T_MAIL_TEXT.

Parameter: p_uname like sy-uname.


************************************************************************
**START-OF-SELECTION
START-OF-SELECTION.
    d_username = p_uname.
    PERFORM POPULATE_EMAIL_TEXT.

    PERFORM SETUP_TRX_AND_RTX_MAILBOXES USING P_RETURN_CODE.
    PERFORM CREATE_AND_SEND_MAIL_OBJECT.


*---------------------------------------------------------------------*
*       FORM POPULATE_EMAIL_TEXT                                      *
*---------------------------------------------------------------------*
*       Inserts text for email message                                *
*---------------------------------------------------------------------*
FORM POPULATE_EMAIL_TEXT.
  CLEAR T_MAIL_TEXT-STRING.            "puts a blank line in
  APPEND T_MAIL_TEXT.
  APPEND T_MAIL_TEXT.

*  adds failed list  on to end of success list.
  T_MAIL_TEXT-STRING = 'Test email message line 1'.
  APPEND T_MAIL_TEXT.
  T_MAIL_TEXT-STRING = 'Test email message line 1'.
  APPEND T_MAIL_TEXT.
  CLEAR T_MAIL_TEXT-STRING.            "puts a blank line in
  APPEND T_MAIL_TEXT.
  T_MAIL_TEXT-STRING = 'Header1    Header2    Header3'.
  APPEND T_MAIL_TEXT.
  T_MAIL_TEXT-STRING = '------------    ------------    ------------'.
  APPEND T_MAIL_TEXT.
ENDFORM.


*&---------------------------------------------------------------------*
*&      Form  SETUP_TRX_&_RTX_MAILBOXES
*&---------------------------------------------------------------------*
*   Ensure that the mailboxes of the sender (INTMGR) are set up OK
*----------------------------------------------------------------------*
FORM SETUP_TRX_AND_RTX_MAILBOXES USING P_RETURN_CODE.

* get the user no of the sender in order to add the mail to the
* user name's outbox for future reference
  SELECT SINGLE * FROM SOUC
           WHERE SAPNAM = SY-UNAME.    "SAP name of a SAPoffice user
  IF SY-SUBRC NE 0.
    "Error finding the SAPoffice user info for the user
    MESSAGE E064(ZR53) WITH SY-UNAME.
    P_RETURN_CODE = 1.
    EXIT.
  ENDIF.
*Get the outbox No for the sender from the user No where the folder
                                       " type is an outbox
  SELECT * FROM SOFD WHERE OWNTP = SOUC-USRTP   "Owner type from ID
                       AND OWNYR = SOUC-USRYR   "Owner year from the ID
                       AND OWNNO = SOUC-USRNO   "Owner number from the I
                       AND FOLRG = 'O'."Output box
  ENDSELECT.

  IF SY-SUBRC NE 0.
    " Error getting folder information for the user
    MESSAGE E065(ZR53) WITH SY-UNAME.
    P_RETURN_CODE = 1.
    EXIT.
  ENDIF.
ENDFORM.                               " SETUP_TRX_&_RTX_MAILBOXES


*&---------------------------------------------------------------------*
*&      Form  CREATE_AND_SEND_MAIL_OBJECT
*&---------------------------------------------------------------------*
FORM CREATE_AND_SEND_MAIL_OBJECT.

  FOLDER_ID-OBJTP = SOFD-FOLTP.        " the folder type ( usually FOL )
  FOLDER_ID-OBJYR = SOFD-FOLYR.        " the folder year ( usually 22 )
  FOLDER_ID-OBJNO = SOFD-FOLNO.        " the folder no.
  OBJECT_TYPE     = 'RAW'.             " the type of object being added

* build up the object information for creating the object
  OBJECT_HD_CHANGE-OBJLA  = SY-LANGU.  " the language of the email
  OBJECT_HD_CHANGE-OBJNAM = 'PS to DM Interface'. " the object name

* mail subject 'Mass Linking of QA, pass/fail'
  MOVE TEXT-002 TO OBJECT_HD_CHANGE-OBJDES.

  OBJECT_HD_CHANGE-DLDAT = SY-DATUM.   " the date of the email
  OBJECT_HD_CHANGE-DLTIM = SY-UZEIT.   " the time of the email
  OBJECT_HD_CHANGE-OBJPRI = '1'.       " the priority ( highest )
  OBJECT_HD_CHANGE-OBJSNS = 'F'.       " the object sensitivity
* F is functional, C - company sensitive

* object_hd_change-skips  = ' '.       " Skip first screen
* object_hd_change-acnam  = 'SM35'.    " Batch imput transaction

* object_hd_change-vmtyp  = 'T'.       " Transaction type

* add the text lines into the contents of the email
  CLEAR OBJCONT.
  REFRESH OBJCONT.
*  free objcont.      " added this to delete the mail contents records
  LOOP AT T_MAIL_TEXT.
    OBJCONT-LINE = T_MAIL_TEXT-STRING.
    APPEND OBJCONT.
  ENDLOOP.
  CLEAR OBJCONT.

* build up the table of receivers for the email
  REC_TAB-RCDAT = SY-DATUM.            " the date to send the email
  REC_TAB-RCTIM = SY-UZEIT.            " the time to send the email
* the SAP username of the person who will receive the email
  REC_TAB-RECNAM = D_USERNAME.
* the user type of the person who will send the email ( USR )
  REC_TAB-SNDTP = SOUC-USRTP.
* the user year of the person who will send the email ( 22 )
  REC_TAB-SNDYR = SOUC-USRYR.
* the user number of the person who will send the email
  REC_TAB-SNDNO = SOUC-USRNO.
* the sap username of the person who will send the email
  REC_TAB-SNDNAM = SY-UNAME.

* get the user info for the receiver of the document
  SELECT SINGLE * FROM SOUC WHERE SAPNAM = D_USERNAME.
  IF SY-SUBRC NE 0.
    WRITE : / TEXT-001, D_USERNAME.    "usnam.
    EXIT.
  ENDIF.

* the user number of the person who will receive the email ( USR )
  REC_TAB-RECNO = SOUC-USRNO.
* the user type of the person who will receive the email ( USR )
  REC_TAB-RECTP = SOUC-USRTP.
* the user year of the person who will receive the email ( USR )
  REC_TAB-RECYR = SOUC-USRYR.
* the priority of the email ( highest )
  REC_TAB-SNDPRI = '1'.
* check for delivery on the email
  REC_TAB-DELIVER = 'X'.
* send express so recipient knows there is a problem
  REC_TAB-SNDEX = 'X'.
* check for a return receipt
  REC_TAB-READ = 'X'.
* the sap username of the person receiving the email
  REC_TAB-ADR_NAME = D_USERNAME.       "usnam.
* add this receiver to the internal table
  APPEND REC_TAB.
  CLEAR REC_TAB.

* call the function to create the object in the outbox of the sender
  CALL FUNCTION 'SO_OBJECT_INSERT'
       EXPORTING
            FOLDER_ID                  = FOLDER_ID
            OBJECT_HD_CHANGE           = OBJECT_HD_CHANGE
            OBJECT_TYPE                = OBJECT_TYPE
            OWNER                      = SY-UNAME
       IMPORTING
            OBJECT_ID                  = NEW_OBJECT_ID
       TABLES
            OBJCONT                    = OBJCONT
            OBJHEAD                    = OBJHEAD
            OBJPARA                    = OBJPARA
            OBJPARB                    = OBJPARB
       EXCEPTIONS
            ACTIVE_USER_NOT_EXIST      = 1
            COMMUNICATION_FAILURE      = 2
            COMPONENT_NOT_AVAILABLE    = 3
            DL_NAME_EXIST              = 4
            FOLDER_NOT_EXIST           = 5
            FOLDER_NO_AUTHORIZATION    = 6
            OBJECT_TYPE_NOT_EXIST      = 7
            OPERATION_NO_AUTHORIZATION = 8
            OWNER_NOT_EXIST            = 9
            PARAMETER_ERROR            = 10
            SUBSTITUTE_NOT_ACTIVE      = 11
            SUBSTITUTE_NOT_DEFINED     = 12
            SYSTEM_FAILURE             = 13
            X_ERROR                    = 14
            OTHERS                     = 15.
  IF SY-SUBRC NE 0.
    MESSAGE A063(ZR53) WITH SY-SUBRC.
    EXIT.
  ENDIF.

* call the function to send the already created email to the receivers
  CALL FUNCTION 'SO_OBJECT_SEND'
       EXPORTING
            FOLDER_ID                  = FOLDER_ID
            OBJECT_ID                  = NEW_OBJECT_ID
            OUTBOX_FLAG                = 'X'
            OWNER                      = SY-UNAME
       TABLES
            RECEIVERS                  = REC_TAB
       EXCEPTIONS
            ACTIVE_USER_NOT_EXIST      = 1
            COMMUNICATION_FAILURE      = 2
            COMPONENT_NOT_AVAILABLE    = 3
            FOLDER_NOT_EXIST           = 4
            FOLDER_NO_AUTHORIZATION    = 5
            FORWARDER_NOT_EXIST        = 6
            NOTE_NOT_EXIST             = 7
            OBJECT_NOT_EXIST           = 8
            OBJECT_NOT_SENT            = 9
            OBJECT_NO_AUTHORIZATION    = 10
            OBJECT_TYPE_NOT_EXIST      = 11
            OPERATION_NO_AUTHORIZATION = 12
            OWNER_NOT_EXIST            = 13
            PARAMETER_ERROR            = 14
            SUBSTITUTE_NOT_ACTIVE      = 15
            SUBSTITUTE_NOT_DEFINED     = 16
            SYSTEM_FAILURE             = 17
            TOO_MUCH_RECEIVERS         = 18
            USER_NOT_EXIST             = 19
            X_ERROR                    = 20
            OTHERS                     = 21.
  IF SY-SUBRC EQ 0.
    MESSAGE I035(ZR53) WITH NEW_OBJECT_ID D_USERNAME. "usnam.
  ELSE.
    MESSAGE I036(ZR53) WITH D_USERNAME."      sy-subrc.
  ENDIF.
ENDFORM.                               " CREATE_AND_SEND_MAIL_OBJECT