Comments

ABAP code to Copy a SAP user account using BDC and email new password




The following ABAP code demonstrates how to Copy a SAP user account. Via the use of a BDC recording of transaction SU01 this program mimics the process that would be used if a user was to do this manually via SU01. The program also retrieves an email address from a personnel record in order to send a confirmation email containing the userís details and new password.

For the entered personnel number it also updates the communication SAP HR infotype with the new SAP username.

*&---------------------------------------------------------------------*
*& Report  ZCOPYUSER
*&
*&---------------------------------------------------------------------*
*&SAP ABAP Development by ERPworkbench
*&
*&---------------------------------------------------------------------*
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




sapdev logo background
sapdev logo sapdev logo


Can't find something on ERPWorkbench? A quick search should fix that: