sapdev logo background
sapdev logo sapdev logo
Comments

Copy SAP user ABAP program using BDC




The following code demonstrates how to Copy a SAP user. The prgram uses a BDC recording of transaction SU01 to mimic the process that would be used if a user was to do this manually. The program also retievs an email address from a personel record in order to sent confirmation email containing user details and new users password. For the entered personell number it also updates communication SAP HR infotype with the new SAP username.

*&---------------------------------------------------------------------*
*& 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 = 'auth@lsapdev.ac.uk'. 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



comments powered by Disqus