Copy SAP user ABAP program using BDC

*&---------------------------------------------------------------------*
*& Report  ZCOPYUSER
*&
*&---------------------------------------------------------------------*
*&SAP ABAP Development by SAPDev
*&
*&---------------------------------------------------------------------*
REPORT  ZCOPYUSER.

tables: pernr.

DATA:   BDCDATA LIKE BDCDATA    OCCURS 0 WITH HEADER LINE.
*       messages of call transaction
DATA:   MESSTAB LIKE BDCMSGCOLL OCCURS 0 WITH HEADER LINE.
*       error session opened (' ' or 'X')
DATA:   E_GROUP_OPENED.
*       message texts
TABLES: T100.
DATA: L_MSTRING(480).
DATA: L_SUBRC LIKE SY-SUBRC,
      ld_user type sy-uname,
      ld_new  type sy-uname,
      ld_email type BAPIADDR3-e_mail,
      ld_return type sy-subrc,
      ld_pass(50) type c.

types: BEGIN OF t_pernr,
  pernr type pernr-pernr,
 end of t_pernr.
data: it_pernr type STANDARD TABLE OF t_pernr,
      wa_pernr like line of it_pernr.

SELECT-OPTIONS: so_pernr for pernr-pernr OBLIGATORY.
PARAMETERS: p_date type sy-datum OBLIGATORY.

SELECTION-SCREEN BEGIN OF BLOCK test with frame title text-001.
PARAMETERS: p_pernr  type pernr-pernr DEFAULT '123456',
            p_user   type sy-uname DEFAULT 'USER',
            p_new    type sy-uname DEFAULT 'USERNEW'.
SELECTION-SCREEN end OF BLOCK test.


************************************************************************
*start-of-selection.
start-of-selection.

  ld_user = p_user.
  ld_new  = p_new.
  wa_pernr-pernr = p_pernr.
  SELECT SINGLE usrid_long
    FROM pa0105
    INTO ld_email
   WHERE pernr = wa_pernr-pernr
     AND usrty = 'MAIL'    "It may be a differnt subtyoe in your system
     AND begda LE sy-datum
     AND endda GE sy-datum.
  if ld_user ne ld_new.
    PERFORM copy_user USING ld_user ld_new p_date
                      CHANGING ld_return ld_pass.
    if ld_return is INITIAL.
      PERFORM update_hr_tables using wa_pernr-pernr ld_new p_date.
      PERFORM SEND_USER_EMAIL using ld_user wa_pernr-pernr ld_new
                                    p_date ld_email ld_pass.
    endif.
  endif.


*&---------------------------------------------------------------------*
*&      Form  COPY_USER
*&---------------------------------------------------------------------*
FORM COPY_USER using p_user p_new p_sdate
               changing p_return p_pass.
  data: ld_sdate(10) type c.
  DATA  g_password1 LIKE xu400-newcode.
  DATA: g_downward_comp.

  ld_sdate(2)   = p_sdate+6(2).
  ld_sdate+2(2) = p_sdate+4(2).
  ld_sdate+4(4) = p_sdate(4).

  CALL FUNCTION 'RSEC_GENERATE_PASSWORD'
    EXPORTING
      alphabet             = space     "Use default
      downwards_compatible = g_downward_comp  "left blank
    IMPORTING
      output               = g_password1
    EXCEPTIONS
      some_error           = 1
      OTHERS               = 2.

  p_pass = g_password1.

  perform bdc_dynpro      using 'SAPLSUU5' '0050'.
  perform bdc_field       using 'BDC_CURSOR'
                                'USR02-BNAME'.
  perform bdc_field       using 'BDC_OKCODE'
                                '=COPY'.
  perform bdc_field       using 'USR02-BNAME'
                                ld_user.
  perform bdc_dynpro      using 'SAPLSUU5' '0200'.
  perform bdc_field       using 'BDC_CURSOR'
                                'CHECK_ADDRESS'.
  perform bdc_field       using 'BDC_OKCODE'
                                '=COPY'.
  perform bdc_field       using 'USR01-BNAME'
                                ld_user.
  perform bdc_field       using 'USR02-BNAME'
                                ld_new.
  perform bdc_field       using 'CHECK_ADDRESS'
                                'X'.
  perform bdc_field       using 'CHECK_DEFAULTS'
                                'X'.
  perform bdc_field       using 'CHECK_PARAMETERS'
                                'X'.
  perform bdc_field       using 'CHECK_REFUSER'
                                'X'.
  perform bdc_field       using 'CHECK_ACTGRP'
                                'X'.
  perform bdc_field       using 'CHECK_PROFILES'
                                'X'.
  perform bdc_field       using 'CHECK_USERGROUPS'
                                'X'.
  perform bdc_field       using 'CHECK_PERS'
                                'X'.
  perform bdc_field       using 'CHECK_LAW'
                                'X'.
  perform bdc_field       using 'CHECK_EASY_ACCESS'
                                'X'.
  perform bdc_dynpro      using 'SAPLSUU5' '0100'.
  perform bdc_field       using 'BDC_OKCODE'
                                '=UPD'.
  perform bdc_field       using 'BDC_CURSOR'
                                'G_PASSWORD2'.
  perform bdc_field       using 'USLOGOND-USTYP'
                                'A'.
  perform bdc_field       using 'G_PASSWORD1'
                                g_password1.
  perform bdc_field       using 'G_PASSWORD2'
                                g_password1.
  perform bdc_field       using 'USLOGOND-GLTGV'
                                ld_sdate.
*  perform bdc_field       using 'USLOGOND-GLTGB'
*                               '31.12.2099'.

  CALL TRANSACTION 'SU01' USING bdcdata MODE 'N' UPDATE 'S'
          MESSAGES INTO messtab.

  L_SUBRC = SY-SUBRC.
  ld_return = l_subrc.

  if L_SUBRC is initial.
    WRITE: / 'Succesfully copied', p_user, 'to', p_new no-gap.
    WRITE: / 'Password:', g_password1.
  else.
    WRITE: / 'Faild to Copy',  p_user , 'to' , p_new.
    LOOP AT MESSTAB.
      SELECT SINGLE * FROM T100 WHERE SPRSL = MESSTAB-MSGSPRA
                                AND   ARBGB = MESSTAB-MSGID
                                AND   MSGNR = MESSTAB-MSGNR.
      IF SY-SUBRC = 0.
        L_MSTRING = T100-TEXT.
        IF L_MSTRING CS '&1'.
          REPLACE '&1' WITH MESSTAB-MSGV1 INTO L_MSTRING.
          REPLACE '&2' WITH MESSTAB-MSGV2 INTO L_MSTRING.
          REPLACE '&3' WITH MESSTAB-MSGV3 INTO L_MSTRING.
          REPLACE '&4' WITH MESSTAB-MSGV4 INTO L_MSTRING.
        ELSE.
          REPLACE '&' WITH MESSTAB-MSGV1 INTO L_MSTRING.
          REPLACE '&' WITH MESSTAB-MSGV2 INTO L_MSTRING.
          REPLACE '&' WITH MESSTAB-MSGV3 INTO L_MSTRING.
          REPLACE '&' WITH MESSTAB-MSGV4 INTO L_MSTRING.
        ENDIF.
        CONDENSE L_MSTRING.
        WRITE: / L_MSTRING.  "MESSTAB-MSGTYP,
      ELSE.
        WRITE: / MESSTAB.
      ENDIF.
    ENDLOOP.
  endif.

ENDFORM.                    " COPY_USER

*----------------------------------------------------------------------*
*        Start new screen                                              *
*----------------------------------------------------------------------*
FORM BDC_DYNPRO USING PROGRAM DYNPRO.
  CLEAR BDCDATA.
  BDCDATA-PROGRAM  = PROGRAM.
  BDCDATA-DYNPRO   = DYNPRO.
  BDCDATA-DYNBEGIN = 'X'.
  APPEND BDCDATA.
ENDFORM.                    "BDC_DYNPRO

*----------------------------------------------------------------------*
*        Insert field                                                  *
*----------------------------------------------------------------------*
FORM BDC_FIELD USING FNAM FVAL.
*  IF FVAL <> NODATA.
  CLEAR BDCDATA.
  BDCDATA-FNAM = FNAM.
  BDCDATA-FVAL = FVAL.
  APPEND BDCDATA.
*  ENDIF.
ENDFORM.                    "BDC_FIELD


*&---------------------------------------------------------------------*
*&      Form  UPDATE_HR_TABLES
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->P_DATE  text
*----------------------------------------------------------------------*
FORM UPDATE_HR_TABLES  USING p_pernr p_new P_DATE.

* return data
  DATA: BEGIN OF 0105_return OCCURS 0.
          INCLUDE STRUCTURE bapiret1.
  DATA: END OF 0105_return.
  data: ld_value type ad_smtpadr,
        ld_pernr type pernr-pernr,
        ld_date  type datum.

  ld_value = p_new.
  ld_pernr = p_pernr.
  ld_date  = p_date.

  CALL FUNCTION 'BAPI_EMPLOYEE_ENQUEUE'
    EXPORTING
      number = p_pernr.

  CALL FUNCTION 'BAPI_EMPLCOMM_CREATE'
    EXPORTING
      employeenumber  = ld_pernr
      subtype         = '0001'
      validitybegin   = ld_date
      validityend     = '99991231'
      communicationid = ld_value
    IMPORTING
      return          = 0105_return.

  read table 0105_return with key type = 'E'.
  if sy-subrc ne 0.
    write:/ 'Infotype 0105 updated to new Username'.
  else.
    write:/ 'Error updating Infotype 0105 to new Username'.
  endif.

  CALL FUNCTION 'BAPI_EMPLOYEE_DEQUEUE'
    EXPORTING
      number = p_pernr.

ENDFORM.                    " UPDATE_HR_TABLES


*&---------------------------------------------------------------------*
*&      Form  SEND_USER_EMAIL
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
FORM SEND_USER_EMAIL using p_user p_pernr p_new p_date p_email p_pass.
  TYPES: TT_HTML_TABLE TYPE STANDARD TABLE OF W3HTML initial size 0.

  TYPES: BEGIN OF SWWW_T_HTML_L,
           LEN  TYPE I,
           LINE(2048),
         END OF SWWW_T_HTML_L,
    SWWW_T_HTML_L_TAB TYPE standard table of SWWW_T_HTML_L initial size 0.
  TYPES: SWWW_T_WA_TAG(4096) TYPE C.             "max workarea fuer tags

  DATA: gd_sendmail TYPE soextreci1-receiver.
  DATA: t_html  TYPE tt_html_table,
        wa_html TYPE w3html,
        document   TYPE sodocchgi1,
        objecthdr  TYPE TABLE OF solisti1 INITIAL SIZE 0,
        wa_objecthdr TYPE solisti1,
        html_line  TYPE swww_t_html_l,
        html       TYPE swww_t_html_l_tab,
        txt        TYPE TABLE OF solisti1 INITIAL SIZE 0,
        wa_txt     TYPE solisti1,
        txt_lines  LIKE sy-tabix,
        hex        TYPE TABLE OF solix INITIAL SIZE 0,
        wa_hex     TYPE solix,
        tabix      LIKE sy-tabix,
        doc_size   LIKE sy-index,
        contents   TYPE TABLE OF sopcklsti1 INITIAL SIZE 0,
        wa_contents TYPE sopcklsti1,
        t_rcvr     TYPE TABLE OF somlreci1 INITIAL SIZE 0,
        wa_t_rcvr     TYPE somlreci1,
        ld_pernr type pernr-pernr,
        ld_uemail type string,
        ld_stext type string,
        ld_course type zsu_roles-course,
        ld_lines type i,
        ld_sendemail type i.

  IF NOT p_email IS INITIAL.

    clear: ld_sendemail.
    REFRESH t_html.
    wa_html =  '<html><body>'.

    CONCATENATE wa_html 'Username changed from' p_user 'to' p_new
         INTO wa_html SEPARATED BY space.
    CONCATENATE wa_html '

Password for new user is:' p_pass
         INTO wa_html SEPARATED BY space.
    APPEND wa_html  TO t_html. CLEAR: wa_html.

    LOOP AT t_html INTO wa_html.
      html_line-len = STRLEN( wa_html ).
      html_line-line = wa_html.
      APPEND html_line TO html.
    ENDLOOP.

    CALL FUNCTION 'WWW_PACK_TABLE'
      TABLES
        html_table        = html
        html_table_packed = txt.

    DESCRIBE TABLE txt LINES txt_lines.
    READ TABLE txt INTO wa_txt INDEX txt_lines.
    doc_size = ( txt_lines - 1 ) * 255 + STRLEN( wa_txt ).

    CLEAR document.
    document-obj_name  = 'docid'.       "p_docid.
    document-obj_descr = 'Username changed'.      "p_subj.
    document-doc_size  = doc_size.
    document-SENSITIVTY = 'P'.         " Use P for Confidential
*     document-SENSITIVTY = 'E'.        " Use E for Private

*   Main body of Email is the HTML document
    CLEAR contents.
    REFRESH contents.
    wa_contents-transf_bin = space.       "ASCII document
    wa_contents-head_start = 1.           "Header starts at line 1...
    wa_contents-head_num   = 0.           "...but we don't want a header
    wa_contents-body_start = 1.           "Text starts at line 1 of "TXT"
    wa_contents-body_num   = txt_lines.   "Number of lines in "TXT"
    wa_contents-doc_type   = 'HTM'.       "HTML format
    wa_contents-doc_size   = doc_size.    "Total number of bytes used
    APPEND wa_contents TO contents.


    wa_t_rcvr-rec_type = 'U'.
    wa_t_rcvr-receiver = p_email.
    APPEND wa_t_rcvr TO t_rcvr.

*       Sender
    gd_sendmail = '[email protected]'.
    CALL FUNCTION 'SO_DOCUMENT_SEND_API1'
      EXPORTING
        document_data              = document
        put_in_outbox              = 'X'
        sender_address             = gd_sendmail
        sender_address_type        = 'INT'
        commit_work                = 'X'
      TABLES
        packing_list               = contents
        object_header              = objecthdr
        contents_txt               = txt
        receivers                  = t_rcvr
      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.
  else.
    write:/ 'No email address found'.
  ENDIF.

ENDFORM.                    " SEND_USER_EMAIL