* __ __ ______ _______ __ __ _______ __ _ __ _ _______ ___ _______ * | | | | _ | | | | | | _ | | | | | | | | | | | * | |_| | | || | | |_| | |_| | |_| | |_| | ___| | | _____| * | | |_||_ | | | | | | |___| | | |_____ * | | __ | | _| | | _ | _ | ___| |___|_____ | * | _ | | | | | |_| _ | _ | | | | | | | |___| |_____| | * |__| |__|___| |_| |_______|__| |__|__| |__|_| |__|_| |__|_______|_______|_______| * platform voor Nederlandstalige HR SAP software componenten www.HRchannels.nl * *------------------------------------------------------------------------------------------- * program : ZHRCHANNELS_INFOTYPE_LOADER * title : Inkomende interface: infotypen opladen * Inbound interface: load infotypes * functional area : Human Resource * environment : 4.7 * program Function : A simple inbound interface which can be used on any * infotype information. Specify the .csv file content starting * with a header line with the supplied fields (multiple header lines * supported). The report will call bapi HR_INFOTYPE_OPERATION to * perform the change (insert, delete, change, all supported). * Documentation : Search for "..." on AbapcadabrA.com * Previous version : This is the initial version * Developer name : Wim Maasdam * Development date : 28/12/2015 * Version : 0.1 *--------------------------------------------------------------------- * Change list: * Date Description * 28/12/2015 Initial release *--------------------------------------------------------------------- REPORT ZHRCHANNELS_INFOTYPE_LOADER. TABLES: sscrfields. " Selection screen purpose only TYPE-POOLS: vrm. " For parameter drop down lists *--------------------------------------------------------------------- * C L A S S D E F I N I T I O N *--------------------------------------------------------------------- CLASS lcl_utilities DEFINITION. PUBLIC SECTION. CLASS-METHODS: set_listbox_static, f4_presentation_file IMPORTING title TYPE any CHANGING filepath TYPE any, f4_server_file CHANGING filepath TYPE any, is_system_productive returning value(is_productive) type boolean. ENDCLASS. *---------------------------------------------------------------------- * CLASS lcl_logging - the message logging and error logging for this * interface is done in the Business Application Log (trx. SLG0, SLG1). * The log is displayed at the end of the report run. Logs can also * be saved (options on the selection screen are available). *---------------------------------------------------------------------- CLASS lcl_logging DEFINITION. PUBLIC SECTION. CLASS-DATA: go_log TYPE REF TO cl_ishmed_bal, gv_object TYPE balobj_d VALUE 'ALERT', gv_subobject TYPE balsubobj VALUE 'PROCESSING', gv_errors_were_logged TYPE boolean VALUE space. CLASS-METHODS: open, set_subject IMPORTING message TYPE any, set_message IMPORTING message TYPE any OPTIONAL par1 TYPE any DEFAULT space par2 TYPE any DEFAULT space par3 TYPE any DEFAULT space par4 TYPE any DEFAULT space msgty TYPE symsgty DEFAULT 'I' PREFERRED PARAMETER message, set_error IMPORTING message TYPE any OPTIONAL par1 TYPE any DEFAULT space par2 TYPE any DEFAULT space PREFERRED PARAMETER message, as_date IMPORTING date TYPE d RETURNING VALUE(r_date) TYPE string, as_number IMPORTING number TYPE any RETURNING VALUE(r_number) TYPE string, conclude. ENDCLASS. "lcl_logging DEFINITION CLASS lcl_controller DEFINITION. PUBLIC SECTION. TYPES: BEGIN OF ty_content, PSKEY type PSKEY, ACTION type PSPAR-ACTIO, RECORD type c length 2500, END OF ty_content, BEGIN OF ty_employee, pernr type pernr_d, massn type p0000-massn, werks type p0001-werks, persg type p0001-persg, persk type p0001-persk, plans type p0001-plans, PPROP type standard table of PPROP with default key, END OF ty_employee. CLASS-DATA: gv_source_filename TYPE c LENGTH 255, gt_employees TYPE STANDARD TABLE OF ty_employee, gt_file_content TYPE STANDARD TABLE OF ty_content, gv_server_file TYPE boolean, gv_test_mode TYPE boolean, gv_save_log type boolean, gv_only_with_errors type boolean, gv_create_in_dialog type c length 1, gv_CAUTION_new_numbers type boolean, gv_CAUTION_dir_update type boolean, gv_CAUTION_dir_update_nocheck type boolean. CLASS-METHODS: read_file IMPORTING filename TYPE string, process. ENDCLASS. *--------------------------------------------------------------------- * C L A S S I M P L E M E N T A T I O N *--------------------------------------------------------------------- CLASS lcl_utilities IMPLEMENTATION. METHOD set_listbox_static. DATA: lt_list TYPE vrm_values, lw_list LIKE LINE OF lt_list. DEFINE set_format. lw_list-key = &1. if &2 is initial. lw_list-text = &1. else. lw_list-text = &2. endif. append lw_list to lt_list. END-OF-DEFINITION. CLEAR lt_list[]. set_format: '' '...', 'OK1' 'Ik weet wat ik doe, controleer aangeleverde data', 'OK2' 'Ik weet wat ik doe, de aangeleverde data is correct'. CALL FUNCTION 'VRM_SET_VALUES' EXPORTING id = 'PA_CHECK' values = lt_list. ENDMETHOD. METHOD f4_presentation_file. DATA: lt_files TYPE STANDARD TABLE OF sdokpath, lw_file TYPE sdokpath, lv_filepath TYPE c LENGTH 120. lv_filepath = filepath. CALL FUNCTION 'TMP_GUI_FILE_OPEN_DIALOG' EXPORTING window_title = title default_filename = lv_filepath TABLES file_table = lt_files EXCEPTIONS OTHERS = 4. IF sy-subrc <> 0. MESSAGE 'Fout bij bepalen bestandsnamen' TYPE 'E'. ELSE. READ TABLE lt_files INDEX 1 INTO lw_file. filepath = lw_file-pathname. ENDIF. ENDMETHOD. "f4_presentation_file METHOD f4_server_file. DATA: lv_old_filepath TYPE string, lv_home type SPFPFLPAR-PVALUE. lv_old_filepath = filepath. CALL FUNCTION '/SAPDMC/LSM_F4_SERVER_FILE' EXPORTING directory = filepath filemask = ' ' IMPORTING serverfile = filepath EXCEPTIONS canceled_by_user = 1 OTHERS = 2. CASE sy-subrc. WHEN 1. filepath = lv_old_filepath. WHEN 2. MESSAGE 'Fout bij bepalen bestandsnamen' TYPE 'E'. ENDCASE. * Concatenate the root to the filename: CALL FUNCTION 'RSAN_SYSTEM_PARAMETER_READ' EXPORTING I_NAME = 'DIR_HOME' IMPORTING E_VALUE = lv_home EXCEPTIONS OTHERS = 2. IF SY-SUBRC = 0. concatenate lv_home filepath into filepath. ENDIF. ENDMETHOD. "f4_server_file METHOD is_system_productive. data: lv_cccategory type t000-cccategory. * Get system category select single cccategory from t000 into lv_cccategory where mandt = sy-mandt. if sy-subrc = 0 and lv_cccategory = 'P'. is_productive = abap_true. else. clear is_productive. endif. ENDMETHOD. ENDCLASS. CLASS lcl_logging IMPLEMENTATION. METHOD open. DATA: lv_extid TYPE balnrext. lv_extid = sy-repid. TRY. CREATE OBJECT go_log EXPORTING i_object = gv_object i_subobject = gv_subobject i_extid = lv_extid i_repid = sy-repid. CATCH cx_ishmed_log. "#EC NO_HANDLER * No actual processing here ENDTRY. ENDMETHOD. METHOD set_subject. DATA: lv_subject TYPE c LENGTH 100. lv_subject = message. * concatenate '==>' lv_subject into lv_subject SEPARATED BY space. TRANSLATE lv_subject TO UPPER CASE. TRY. go_log->add_free_text( EXPORTING i_msg_type = 'W' i_text = lv_subject ). CATCH cx_ishmed_log. "#EC NO_HANDLER * No actual logic on catch ENDTRY. ENDMETHOD. "set_subject METHOD set_message. " importing message type any, par1, par2 DATA: lv_message TYPE c LENGTH 100. lv_message = message. REPLACE '&' WITH par1 INTO lv_message. CONDENSE lv_message. REPLACE '&' WITH par2 INTO lv_message. CONDENSE lv_message. REPLACE '&' WITH par3 INTO lv_message. CONDENSE lv_message. REPLACE '&' WITH par4 INTO lv_message. CONDENSE lv_message. TRY. go_log->add_free_text( EXPORTING i_msg_type = msgty i_text = lv_message ). CATCH cx_ishmed_log. "#EC NO_HANDLER * No actual logic on catch ENDTRY. ENDMETHOD. "set_message METHOD set_error. " importing message type any, par1, par2 DATA: lv_message TYPE c LENGTH 100. CHECK NOT go_log IS INITIAL. lv_message = message. REPLACE '&' WITH par1 INTO lv_message. REPLACE '&' WITH par2 INTO lv_message. CONDENSE lv_message. TRY. go_log->add_free_text( EXPORTING i_msg_type = 'E' i_text = lv_message ). lcl_logging=>gv_errors_were_logged = abap_true. CATCH cx_ishmed_log. "#EC NO_HANDLER * No actual logic on catch ENDTRY. ENDMETHOD. "set_error METHOD as_date. * Small utility method, which can be used to pass date parameters to a message * It can be used to "clean up" parameter values that are passed to set_message or set_error DATA: lv_chars TYPE c LENGTH 10. WRITE date TO lv_chars DD/MM/YYYY. r_date = lv_chars. ENDMETHOD. METHOD as_number. * Small utility method, which can be used to strip leading zero's from a number. * It can be used to "clean up" parameter values that are passed to set_message or set_error r_number = number. SHIFT r_number LEFT DELETING LEADING '0'. CASE r_number. when '.00'. r_number = '0.00'. when ''. r_number = '0'. ENDCASE. ENDMETHOD. METHOD conclude. TRY. IF sy-batch = space. go_log->display( ). ENDIF. if lcl_controller=>gv_test_mode = abap_false and lcl_controller=>gv_save_log = abap_true. IF lcl_controller=>gv_only_with_errors = abap_false or ( lcl_controller=>gv_only_with_errors = abap_true and gv_errors_were_logged = abap_true ). go_log->save( ). MESSAGE 'Applicatie log is opgeslagen'(m30) TYPE 'S'. ENDIF. endif. CATCH cx_ishmed_log. MESSAGE 'Log (BAL) kon niet opgeslagen worden'(m31) TYPE 'E'. ENDTRY. ENDMETHOD. ENDCLASS. "lcl_logging IMPLEMENTATION CLASS lcl_controller IMPLEMENTATION. METHOD read_file. DATA: lt_data TYPE STANDARD TABLE OF string, lv_dataline TYPE string, lv_buffer type c length 2500, lw_file_content TYPE ty_content, lv_pernr type pernr_d, lt_columnnames type STANDARD TABLE OF string, lv_columnname type string, lt_fieldvalues type STANDARD TABLE OF string, lv_fieldvalue type string, lt_fieldnames_PSKEY type STANDARD TABLE OF DNTAB, lt_fieldnames type STANDARD TABLE OF DNTAB, lw_fieldname type DNTAB, lv_fieldname type c length 80, lv_infotype_tabname type DNTAB-TABNAME, lv_infotype type P0001-INFTY, lv_char type c length 20, lw_return type BAPIRETURN1, BEGIN OF lw_totals, headerlines type n length 5, datalines type n length 5, employees type n length 5, END OF lw_totals, lw_employee type ty_employee, lt_pernrs type STANDARD TABLE OF pernr_d, lw_p0000 type p0000, lw_p0001 type p0001, lw_p0002 type p0002, lw_PPROP type PPROP. FIELD-SYMBOLS: type any, type any, type any. define set_PPROP. lw_PPROP-INFTY = &1. lw_PPROP-FNAME = &2. lw_PPROP-FVAL = &3. append lw_PPROP to lw_employee-PPROP. end-of-definition. CLEAR: gt_employees[]. CLEAR: lt_data[], lt_columnnames[],lw_totals. lcl_logging=>set_message( 'Bestand wordt ingelezen:' ). lcl_logging=>set_message( filename ). * The input file can be opened via the frontend as well as backend, depending * on whether the report runs in the background: IF gv_server_file = abap_false. CALL FUNCTION 'GUI_UPLOAD' EXPORTING filename = filename TABLES data_tab = lt_data EXCEPTIONS OTHERS = 4. IF sy-subrc <> 0. lcl_logging=>set_error( 'Het invoerbestand kon niet worden gelezen' ). EXIT. ENDIF. ELSE. * Pick up the file from the back-end - still microsoft file path: OPEN DATASET filename FOR INPUT IN TEXT MODE ENCODING DEFAULT. if sy-subrc <> 0. lcl_logging=>set_error( 'Het invoerbestand kon niet worden gelezen' ). EXIT. else. * Read line by line: while sy-subrc = 0. read dataset filename into lv_dataline. append lv_dataline to lt_data. endwhile. close dataset filename. endif. ENDIF. if not lt_data[] is initial. * Fetch the fieldnames for the key fields: CALL FUNCTION 'NAMETAB_GET' EXPORTING ONLY = 'T' TABNAME = 'PSKEY' TABLES NAMETAB = lt_fieldnames_PSKEY. * Process the file into GT_FILE_CONTENT: CLEAR: gt_file_content[], gt_employees[]. * Process each line from the file as relevant data: LOOP AT lt_data INTO lv_dataline. CLEAR lw_file_content. * Check whether this is a header line: from which data-mapping settings are derived: if lv_dataline cs 'PERNR' and lv_dataline cs 'INFTY' and lv_dataline cs 'ACTION'. * Compose the fields list, which is used to populate the infotype: clear: lt_columnnames[]. TRANSLATE lv_dataline TO UPPER CASE. split lv_dataline at ';' into table lt_columnnames. add 1 to lw_totals-headerlines. else. * We're looking at an actual data line if lt_columnnames[] is initial. lcl_logging=>set_error( 'Inlezen: Kolom koppen niet gevonden (PERNR, INFTY en ACTION)' ). EXIT. endif. clear: lt_fieldvalues[]. add 1 to lw_totals-datalines. split lv_dataline at ';' into table lt_fieldvalues. * First determine the infotype: read table lt_columnnames with key table_line = 'INFTY' TRANSPORTING NO FIELDS. if sy-subrc <> 0. lcl_logging=>set_error( 'Inlezen: Infotype kon niet bepaald worden' ). EXIT. else. read table lt_fieldvalues into lv_fieldvalue index sy-tabix. write lv_fieldvalue to lv_infotype RIGHT-JUSTIFIED. overlay lv_infotype with '0000'. concatenate 'P' lv_infotype into lv_infotype_tabname. *======================================================================== ASSIGN lw_file_content-record TO CASTING TYPE (lv_infotype_tabname). if sy-subrc <> 0. lcl_logging=>set_error( message = 'Inlezen: toewijzing structuur & niet gelukt' par1 = lv_infotype_tabname ). EXIT. endif. *======================================================================== CALL FUNCTION 'NAMETAB_GET' EXPORTING ONLY = 'T' TABNAME = lv_infotype_tabname TABLES NAMETAB = lt_fieldnames. * Check the database for current settings - in case they are already available: * concatenate 'PA' lv_infotype into lv_infotype_tabname. * Fetch key-values: loop at lt_columnnames into lv_columnname. read table lt_fieldvalues into lv_fieldvalue index sy-tabix. read table lt_fieldnames_PSKEY with key fieldname = lv_columnname TRANSPORTING NO FIELDS. check sy-subrc = 0. concatenate 'LW_FILE_CONTENT-PSKEY-' lv_columnname into lv_fieldname. * For some of the fields, the leading zero's are added: case lv_columnname. when 'PERNR'. write lv_fieldvalue to lv_pernr RIGHT-JUSTIFIED. overlay lv_pernr with '00000000'. lv_fieldvalue = lv_pernr. when 'INFTY'. write lv_fieldvalue to lv_infotype RIGHT-JUSTIFIED. overlay lv_infotype with '0000'. lv_fieldvalue = lv_infotype. when 'MASSG' or 'MASSN'. write lv_fieldvalue to lv_char(2) RIGHT-JUSTIFIED. overlay lv_fieldvalue with '00'. endcase. ASSIGN (lv_fieldname) to . = lv_fieldvalue. endloop. * Check the database: CALL FUNCTION 'HR_INFOTYPE_GETDETAIL' EXPORTING INFTY = lv_infotype NUMBER = LW_FILE_CONTENT-PSKEY-PERNR SUBTYPE = LW_FILE_CONTENT-PSKEY-SUBTY OBJECTID = LW_FILE_CONTENT-PSKEY-OBJPS LOCKINDICATOR = LW_FILE_CONTENT-PSKEY-SPRPS VALIDITYBEGIN = LW_FILE_CONTENT-PSKEY-BEGDA VALIDITYEND = LW_FILE_CONTENT-PSKEY-ENDDA RECORDNUMBER = LW_FILE_CONTENT-PSKEY-SEQNR * TCLAS = 'A' IMPORTING RETURN = lw_return RECORD = lv_buffer. if lw_return-TYPE <> 'E'. * Original values available, use as defaults: ASSIGN lv_buffer TO CASTING TYPE (lv_infotype_tabname). MOVE-CORRESPONDING to . endif. * Scoop up all the fields that are known on the given infotype: loop at lt_columnnames into lv_columnname. read table lt_fieldvalues into lv_fieldvalue index sy-tabix. read table lt_fieldnames with key fieldname = lv_columnname into lw_fieldname. check sy-subrc = 0. concatenate '-' lv_columnname into lv_fieldname. ASSIGN (lv_fieldname) to . * Date fields like dd.mm.yyyy are accepted (european style only) if lw_fieldname-DATATYPE = 'DATS' and strlen( lv_fieldvalue ) = 10. concatenate lv_fieldvalue+6(4) lv_fieldvalue+3(2) lv_fieldvalue(2) into lv_fieldvalue. endif. *============================================ move lv_fieldvalue to . *============================================ endloop. * Determine the action: read table lt_columnnames with key table_line = 'ACTION' TRANSPORTING NO FIELDS. if sy-subrc <> 0. lcl_logging=>set_error( 'Inlezen: Actie kon niet bepaald worden (kolom ACTION)' ). EXIT. else. read table lt_fieldvalues into lv_fieldvalue index sy-tabix. lw_file_content-action = lv_fieldvalue. case lw_file_content-action. when space. lcl_logging=>set_error( 'Inlezen: lege actiecode (kolom ACTION)' ). EXIT. when 'NEW'. * The action code to create a new employee with when 'MOD' or 'INS' or 'DEL' or 'EDQ' or 'COP' or 'CHK'. *CONSTANTS: CHANGE 'MOD', CREATE 'INS', DELETE 'DEL', APPROVE 'EDQ', CREATESUCCESSOR 'COP', CHECK_RECORD 'CHK'. when others. lcl_logging=>set_error( message = 'Inlezen: ongeldige actiecode (&)' par1 = lw_file_content-action ). EXIT. endcase. endif. * Update internal administration lw_employee-pernr = lw_file_content-pskey-pernr. append lw_employee to gt_employees. append lw_file_content to gt_file_content. endif. endif. IF lcl_logging=>gv_errors_were_logged = abap_true. lcl_logging=>set_message( 'Proces onderbroken bij inlezen' ). EXIT. ENDIF. ENDLOOP. ELSE. lcl_logging=>set_error( 'Geen gegevens in het invoerbestand' ). EXIT. ENDIF. * Final touch on internal administration: SORT gt_employees BY PERNR. DELETE ADJACENT DUPLICATES FROM gt_employees COMPARING PERNR. * Employee data which is needed to create an employee is gathered here: select pernr from pa0000 into table lt_pernrs for all entries in gt_employees where pernr = gt_employees-pernr. loop at gt_employees into lw_employee. * Is this a new employee number ? read table lt_pernrs with key table_line = lw_employee-pernr TRANSPORTING NO FIELDS. if sy-subrc <> 0 or lcl_controller=>gv_CAUTION_new_numbers = abap_true. * Gather all information for the HR_MAINTAIN_MASTERDATA call, for infortypes 0000, 0001 and 0002 read table gt_file_content into lw_file_content with key PSKEY-infty = '0000' PSKEY-pernr = lw_employee-pernr. if sy-subrc = 0. lw_p0000 = lw_file_content-record. lw_employee-massn = lw_p0000-massn. set_PPROP: '0000' 'P0000-MASSG' lw_p0000-massg. else. lw_employee-massn = '01'. "Default: Hiring endif. read table gt_file_content into lw_file_content with key PSKEY-infty = '0001' PSKEY-pernr = lw_employee-pernr. if sy-subrc = 0. lw_p0001 = lw_file_content-record. lw_employee-plans = lw_p0001-plans. lw_employee-werks = lw_p0001-werks. lw_employee-persg = lw_p0001-persg. lw_employee-persk = lw_p0001-persk. set_PPROP: '0001' 'PSPAR-PLANS' lw_p0001-PLANS. * '0001' 'PSPAR-WERKS' lw_p0001-WERKS, * '0001' 'PSPAR-PERSG' lw_p0001-PERSG, * '0001' 'PSPAR-PERSK' lw_p0001-PERSK. endif. read table gt_file_content into lw_file_content with key PSKEY-infty = '0002' PSKEY-pernr = lw_employee-pernr. if sy-subrc = 0. assign lw_file_content-record to casting type p0002. lw_p0002 = . set_PPROP: * '0002' 'Q0002-ANREX' lw_p0002-anred, '0002' 'Q0002-ANREX' 'Mr', '0002' 'P0002-NACHN' lw_p0002-nachn, '0002' 'P0002-VORNA' lw_p0002-vorna, '0002' 'P0002-INITS' lw_p0002-inits, '0002' 'P0002-GBDAT' lw_p0002-gbdat, '0002' 'P0002-NATIO' lw_p0002-natio. endif. modify gt_employees from lw_employee. endif. endloop. * Summary of the information from the file: lcl_logging=>set_message( message = '& regels ingelezen' par1 = lcl_logging=>as_number( lw_totals-datalines ) ). lcl_logging=>set_message( message = '& kopregels gebruikt' par1 = lcl_logging=>as_number( lw_totals-headerlines ) ). describe table gt_employees lines lw_totals-employees. lcl_logging=>set_message( message = '& medewerkers' par1 = lcl_logging=>as_number( lw_totals-employees ) ). ENDMETHOD. METHOD process. DATA: BEGIN OF lw_totals, total_updates type n length 5, total_skipped type n length 5, total_failed type n length 5, END OF lw_totals, lw_employee type ty_employee, lw_return type BAPIRETURN1, lw_file_content type ty_content, lv_pernr type pernr_d. clear lw_totals. lcl_logging=>set_subject( 'Verwerken van de gegevens' ). LOOP AT gt_employees into lw_employee. *============================================================ CLEAR: lw_return. CALL FUNCTION 'BAPI_EMPLOYEE_ENQUEUE' EXPORTING number = lw_employee-pernr IMPORTING return = lw_return. IF NOT lw_return IS INITIAL. lcl_logging=>set_error( message = '&: Kon niet verwerkt worden - geblokkeerd' par1 = lw_employee-pernr ). LOOP AT gt_file_content INTO lw_file_content WHERE PSKEY-pernr = lw_employee-pernr . add 1 to lw_totals-total_failed. ENDLOOP. ELSE. * HR_INFOTYPE_OPERATION can itself not be used to create employee * data. Thus when an infotype 0000 is processed and it is for a new * employee, processing is done through HR_MAINTAIN_MASTERDATA: if not lw_employee-massn is initial. * Fetch the first record from gt_file_content - for the employee: read table gt_file_content into lw_file_content with key PSKEY-pernr = lw_employee-pernr. lv_pernr = lw_employee-pernr. if gv_CAUTION_new_numbers = abap_true. clear lv_pernr. endif. CALL FUNCTION 'HR_MAINTAIN_MASTERDATA' EXPORTING PERNR = lv_pernr MASSN = lw_employee-massn BEGDA = lw_file_content-PSKEY-begda ENDDA = lw_file_content-PSKEY-endda OBJPS = lw_file_content-PSKEY-OBJPS SEQNR = lw_file_content-PSKEY-SEQNR SPRPS = lw_file_content-PSKEY-SPRPS SUBTY = lw_file_content-PSKEY-SUBTY WERKS = lw_employee-werks PERSG = lw_employee-persg PERSK = lw_employee-persk PLANS = lw_employee-plans DIALOG_MODE = gv_create_in_dialog LUW_MODE = '0' NO_EXISTENCE_CHECK = 'X' NO_ENQUEUE = 'X' IMPORTING * RETURN = RETURN1 = lw_return * HR_RETURN = TABLES PROPOSED_VALUES = lw_employee-PPROP. if lw_return-type = 'E' . lcl_logging=>set_error( message = '&: Fout bij aanmaken medewerker' par1 = lw_employee-pernr ). lcl_logging=>set_error( lw_return-message ). add 1 to lw_totals-total_failed. continue. "With next loop pass - gt_employees else. add 1 to lw_totals-total_updates. lcl_logging=>set_message( message = '&: Medewerker aangemaakt' par1 = lw_employee-pernr ). IF gv_test_mode = abap_true. ROLLBACK WORK. LOOP AT gt_file_content INTO lw_file_content WHERE PSKEY-pernr = lw_employee-pernr . add 1 to lw_totals-total_failed. ENDLOOP. continue. "With next loop pass - gt_employees else. COMMIT WORK AND WAIT. endif. endif. endif. * Determine which entries are currently available: LOOP AT gt_file_content INTO lw_file_content WHERE PSKEY-pernr = lw_employee-pernr. if lw_file_content-action <> 'CHK' and gv_CAUTION_dir_update_nocheck = abap_false. * The check-call - operation CHK: CALL FUNCTION 'HR_INFOTYPE_OPERATION' EXPORTING INFTY = lw_file_content-PSKEY-infty NUMBER = lw_file_content-PSKEY-pernr SUBTYPE = lw_file_content-PSKEY-subty VALIDITYEND = lw_file_content-PSKEY-endda VALIDITYBEGIN = lw_file_content-PSKEY-begda RECORD = lw_file_content-record OPERATION = 'CHK' IMPORTING RETURN = lw_return. lcl_logging=>set_error( message = '&/&: Fout bij controle' par1 = lw_employee-pernr par2 = lw_file_content-PSKEY-infty ). lcl_logging=>set_error( lw_return-message ). add 1 to lw_totals-total_failed. continue. endif. if gv_CAUTION_dir_update = abap_true. * Direct table update: if lw_file_content-action = 'CHK'. lcl_logging=>set_error( message = '&/&: Direct table update - actie CHK (overgeslagen)' par1 = lw_employee-pernr par2 = lw_file_content-PSKEY-infty ). continue. endif. IF gv_test_mode = abap_false. * To do a direct table update, the PAnnnn record needs to be prepared: data: lv_tablename type c length 6, lv_buffer type c length 2500. field-symbols: type any. concatenate 'PA' lw_file_content-PSKEY-infty into lv_tablename. * Transform the Pnnnn to the PAnnnn structure, add client, remove infotype: lv_buffer = sy-mandt. lv_buffer+3(8) = lw_file_content-record(8). lv_buffer+11 = lw_file_content-record+12. * What's the character 35 thing ? - I don't know ! * LV_BUFFER+34 = LV_BUFFER+35. assign lv_buffer to CASTING type (lv_tablename). if sy-subrc <> 0. lcl_logging=>set_error( message = '&/&: Interne fout - directe tabel update' par1 = lw_employee-pernr par2 = lw_file_content-PSKEY-infty ). else. *==================================================== case lw_file_content-action. when 'INS'. modify (lv_tablename) from . if sy-subrc <> 0. lcl_logging=>set_error( message = '&/&: Interne fout - update failure' par1 = lw_employee-pernr par2 = lw_file_content-PSKEY-infty ). else. add 1 to lw_totals-total_updates. endif. endcase. *==================================================== endif. ENDIF. else. CALL FUNCTION 'HR_INFOTYPE_OPERATION' EXPORTING INFTY = lw_file_content-PSKEY-infty NUMBER = lw_file_content-PSKEY-pernr SUBTYPE = lw_file_content-PSKEY-subty VALIDITYEND = lw_file_content-PSKEY-endda VALIDITYBEGIN = lw_file_content-PSKEY-begda RECORD = lw_file_content-record OPERATION = lw_file_content-action NOCOMMIT = abap_true IMPORTING RETURN = lw_return. if lw_return-type = 'E' . lcl_logging=>set_error( message = '&/&: Fout bij verwerking' par1 = lw_employee-pernr par2 = lw_file_content-PSKEY-infty ). lcl_logging=>set_error( lw_return-message ). add 1 to lw_totals-total_failed. else. add 1 to lw_totals-total_updates. lcl_logging=>set_message( message = '&/&: Verwerkt (actie &)' par1 = lw_employee-pernr par2 = lw_file_content-PSKEY-infty par3 = lw_file_content-action ). IF gv_test_mode = abap_true. ROLLBACK WORK. else. COMMIT WORK AND WAIT. endif. endif. endif. "Direct table update or BAPI call ENDLOOP. CALL FUNCTION 'BAPI_EMPLOYEE_DEQUEUE' EXPORTING number = lw_employee-pernr. ENDIF. *============================================================ ENDLOOP. lcl_logging=>set_subject( 'Totalen' ). lcl_logging=>set_message( message = '& verzoeken genegeerd (waren al aangemaakt)' par1 = lcl_logging=>as_number( lw_totals-total_skipped ) ). lcl_logging=>set_message( message = '& verzoeken verwerkt' par1 = lcl_logging=>as_number( lw_totals-total_updates ) ). lcl_logging=>set_message( message = '& verzoeken konden niet verwerkt worden' par1 = lcl_logging=>as_number( lw_totals-total_failed ) ). IF gv_test_mode = abap_true. lcl_logging=>set_message( '==> Test modus - geen aanpassingen doorgevoerd' ). ENDIF. lcl_logging=>set_subject( ' Verwerking afgerond ' ). ENDMETHOD. ENDCLASS. *--------------------------------------------------------------------- * S E L E C T I O N - S C R E E N *--------------------------------------------------------------------- * The filename SELECTION-SCREEN: BEGIN OF LINE, COMMENT 1(18) lbl_001. PARAMETERS pa_filen TYPE string LOWER CASE VISIBLE LENGTH 50. SELECTION-SCREEN: END OF LINE, BEGIN OF LINE, position 20. PARAMETER pa_srce AS CHECKBOX DEFAULT abap_false USER-COMMAND enter. SELECTION-SCREEN: COMMENT 23(25) lbl_002 FOR FIELD pa_srce, END OF LINE, SKIP, BEGIN OF LINE, POSITION 20. PARAMETER pa_dialo AS CHECKBOX DEFAULT abap_false. SELECTION-SCREEN: COMMENT 23(40) lbl_003 FOR FIELD pa_dialo, END OF LINE, BEGIN OF LINE, POSITION 20. PARAMETER pa_test AS CHECKBOX DEFAULT abap_true. SELECTION-SCREEN: COMMENT 23(25) lbl_004 FOR FIELD pa_test, END OF LINE, BEGIN OF LINE, PUSHBUTTON 1(16) lbl_but USER-COMMAND slg1, POSITION 20. PARAMETER pa_balsv TYPE c AS CHECKBOX DEFAULT 'X'. SELECTION-SCREEN: COMMENT 35(12) lbl_005 FOR FIELD pa_balsv, POSITION 47. PARAMETER pa_balsx TYPE c AS CHECKBOX DEFAULT 'X'. SELECTION-SCREEN: COMMENT 49(25) lbl_006 FOR FIELD pa_balsx, END OF LINE, ULINE, BEGIN OF LINE, COMMENT 1(18) lbl_007. PARAMETERS: pa_check TYPE char20 AS LISTBOX VISIBLE LENGTH 30 USER-COMMAND ENTER. SELECTION-SCREEN: END OF LINE, BEGIN OF LINE, COMMENT 15(5) lbl_alrt modif id CHK, POSITION 20. PARAMETERS: pa_produ type char80 LOWER CASE modif id RO. SELECTION-SCREEN: END OF LINE, BEGIN OF LINE, POSITION 20. PARAMETERS: pa_renum as checkbox default space modif id OK1. SELECTION-SCREEN: COMMENT 23(40) lbl_008 for field pa_renum, END OF LINE, BEGIN OF LINE, POSITION 20. PARAMETERS: pa_direc as checkbox default space modif id OK1. SELECTION-SCREEN: COMMENT 23(40) lbl_009 for field pa_direc, END OF LINE, BEGIN OF LINE, POSITION 23. PARAMETERS: pa_dire2 as checkbox default space modif id OK2. SELECTION-SCREEN: COMMENT 26(40) lbl_010 for field pa_dire2, END OF LINE. SELECTION-SCREEN: SKIP, BEGIN OF LINE, PUSHBUTTON (70) lbl_link USER-COMMAND HRCHANNELS VISIBLE LENGTH 5, END OF LINE. AT SELECTION-SCREEN ON VALUE-REQUEST FOR pa_filen. if pa_srce = abap_false. lcl_utilities=>f4_presentation_file( EXPORTING title = 'Kies bestand' CHANGING filepath = pa_filen ). else. lcl_utilities=>f4_server_file( CHANGING filepath = pa_filen ). endif. AT SELECTION-SCREEN OUTPUT. IF lcl_utilities=>is_system_productive( ) = abap_true. pa_produ = 'Dit is een ACTIEF PRODUCTIE systeem'. lbl_alrt = '@1B@'. ELSE. pa_produ = 'Dit is geen productie systeem'. lbl_alrt = '@1A@'. ENDIF. LOOP AT SCREEN. if pa_check = space. if screen-group1(2) = 'OK'. screen-input = 0. screen-output = 0. screen-active = 0. modify screen. endif. elseif pa_check = 'OK1'. if screen-group1 = 'OK2'. screen-input = 0. modify screen. endif. endif. if screen-group1 = 'RO'. "Read-Only screen-input = 0. screen-intensified = 1. modify screen. endif. ENDLOOP. *--------------------------------------------------------------------- AT SELECTION-SCREEN. CASE sscrfields-ucomm. WHEN 'SLG1'. SET PARAMETER ID 'BALOBJ' FIELD lcl_logging=>gv_object. SET PARAMETER ID 'BALSUBOBJ' FIELD lcl_logging=>gv_subobject. SET PARAMETER ID 'BALEXT' FIELD sy-repid. CALL TRANSACTION 'SLG1'. WHEN 'ABAPCADABRA'. CALL FUNCTION 'CALL_BROWSER' EXPORTING URL = 'http://abapcadabra.com/index.php/interfacing/559-mail-multiple-files' EXCEPTIONS OTHERS = 0. ENDCASE. *--------------------------------------------------------------------- * I N I T I A L I Z A T I O N *--------------------------------------------------------------------- INITIALIZATION. lbl_link = '@N5\QMeer op HRchannels.nl@'. lbl_but = 'Applicatie log'. lbl_001 = 'Invoerbestand'. lbl_002 = 'Server bestand'. lbl_003 = 'Nieuwe medewerkers in dialoog mode'. lbl_004 = 'Test mode (geen updates)'. lbl_005 = 'Log opslaan'. lbl_006 = '.. alleen bij fouten'. lbl_007 = 'Meer.. (controle)'. lbl_008 = 'Laat SAP nieuwe nummers aanmaken'. lbl_009 = 'Gebruik DIRECT TABLE UPDATE methode'. lbl_010 = '... zonder controle'. lbl_alrt = '@1B@'. lcl_utilities=>set_listbox_static( ). *---------------------------------------------------------------------- * S T A R T - O F - S E L E C T I O N *---------------------------------------------------------------------- START-OF-SELECTION. lcl_logging=>open( ). lcl_logging=>set_subject( 'Start van de interface' ). if pa_test = abap_true. lcl_logging=>set_message( '==> Test modus - geen aanpassingen doorgevoerd' ). endif. * Process selection screen fields: translation values from productcode to subtype lcl_controller=>gv_server_file = pa_srce. lcl_controller=>gv_create_in_dialog = '0'. if pa_dialo = abap_true. lcl_controller=>gv_create_in_dialog = '1'. endif. lcl_controller=>gv_test_mode = pa_test. lcl_controller=>gv_save_log = PA_BALSV. lcl_controller=>gv_only_with_errors = PA_BALSX. lcl_controller=>gv_CAUTION_new_numbers = pa_renum. lcl_controller=>gv_CAUTION_dir_update = pa_direc. lcl_controller=>gv_CAUTION_dir_update_nocheck = pa_dire2. lcl_controller=>read_file( pa_filen ). IF lcl_logging=>gv_errors_were_logged = abap_false. lcl_controller=>process( ). ENDIF. lcl_logging=>conclude( ). * _______ _______ _______ _______ _______ _______ ______ _______ _______ ______ _______ * | _ | _ | _ | | | _ | || _ | _ | _ | | _ | * | |_| | |_| | |_| | _ | | |_| | _ | |_| | |_| | | || | |_| | * | | | | |_| | | | | | | | | |_||_| | * | | _ || | ___| _| | |_| | | _ || __ | | * | _ | |_| | _ | | | |_| _ | | _ | |_| | | | | _ | * |__| |__|_______|__| |__|___| |_______|__| |__|______||__| |__|_______|___| |_|__| |__| * www.abapcadabra.com