Registration

Dear SAP Community Member,
In order to fully benefit from what the SAP Community has to offer, please register at:
http://scn.sap.com
Thank you,
The SAP Community team.
Skip to end of metadata
Go to start of metadata
Error rendering macro 'code': Invalid value specified for parameter 'lang'
REPORT ZF_VENDOR_UPDATE_COM NO STANDARD PAGE HEADING
                                       LINE-SIZE 132
                                       LINE-COUNT 55
                                       MESSAGE-ID ZM.
*-----------------------------------------------------------------------
* SAP Tables
*-----------------------------------------------------------------------
TABLES: LFA1,  "Vendor Master (General Section)
        LFB1,  "Vendor Master (Company Code)
        LFM1,  "Vendor Master (purchasing organization data)
        TSAC,  "Communication types (central address management)
        T100.  "Messages
*-----------------------------------------------------------------------
* Internal Tables
*-----------------------------------------------------------------------
TYPES: BEGIN OF TYP_K_KBUKA,
         LIFNR LIKE LFA1-LIFNR,
         BUKRS LIKE LFB1-BUKRS,
       END OF TYP_K_KBUKA.
TYPES: BEGIN OF TYP_TSAC,
         COMM_TYPE LIKE TSAC-COMM_TYPE,
       END OF TYP_TSAC.
TYPES: BEGIN OF TYP_LFA1,
         LIFNR LIKE LFA1-LIFNR,
         LAND1 LIKE LFA1-LAND1,
         ADRNR LIKE LFA1-ADRNR,
       END OF TYP_LFA1.
* File data table.
DATA: IT_KBUKA TYPE HASHED TABLE OF TYP_K_KBUKA WITH UNIQUE KEY
                                    LIFNR BUKRS WITH HEADER LINE.
DATA: IT_TSAC  TYPE HASHED TABLE OF TYP_TSAC WITH UNIQUE KEY COMM_TYPE
                                    WITH HEADER LINE.
DATA: IT_LFA1  TYPE HASHED TABLE OF TYP_LFA1 WITH UNIQUE KEY
                                    LIFNR WITH HEADER LINE.
DATA: BEGIN OF T_FILEDATA OCCURS 0,
        RECORD(1000) TYPE C,
      END OF T_FILEDATA.
* Vendor file layout
DATA: BEGIN OF T_VEND OCCURS 0,
        EKORG       LIKE RF02K-EKORG,
        LIFNR       LIKE LFA1-LIFNR,
        DEFLT_COMM  LIKE ADDR1_DATA-DEFLT_COMM,
        FAX         LIKE SZA1_D0100-FAX_NUMBER,
        TEL         LIKE SZA1_D0100-TEL_NUMBER,
        EMAIL       LIKE SZA1_D0100-SMTP_ADDR ,
        VERKF       LIKE LFM1-VERKF,     "Contact person
        WAERS       LIKE LFM1-WAERS,     "Order currency
        ZTERM       LIKE LFM1-ZTERM,     "Payment terms
        WEBRE       LIKE LFM1-WEBRE,     "GR-based invoice inveri check
      END OF T_VEND.
DATA: BEGIN OF BDCDATA OCCURS 0.
        INCLUDE STRUCTURE BDCDATA.
DATA: END OF BDCDATA.
DATA: IT_ERROR      LIKE T_VEND OCCURS 0,
      MESSTAB       LIKE BDCMSGCOLL OCCURS 0 WITH HEADER LINE,
      T_BAPIAD1VL   TYPE TABLE OF BAPIAD1VL  WITH HEADER LINE,
      T_BAPIADTEL   TYPE TABLE OF BAPIADTEL  WITH HEADER LINE,
      T_BAPIADFAX   TYPE TABLE OF BAPIADFAX  WITH HEADER LINE,
      T_BAPIADSMTP  TYPE TABLE OF BAPIADSMTP WITH HEADER LINE,
      T_BAPICOMREM  TYPE TABLE OF BAPICOMREM WITH HEADER LINE,
      T_RET         TYPE TABLE OF BAPIRET2   WITH HEADER LINE,
      TX_BAPIAD1VLX TYPE TABLE OF BAPIAD1VLX WITH HEADER LINE,
      TX_BAPIADTELX TYPE TABLE OF BAPIADTELX WITH HEADER LINE,
      TX_BAPIADFAXX TYPE TABLE OF BAPIADFAXX WITH HEADER LINE,
      TX_BAPIADSMTX TYPE TABLE OF BAPIADSMTX WITH HEADER LINE,
      TX_BAPICOMREX TYPE TABLE OF BAPICOMREX WITH HEADER LINE.
* For validate telephone number
DATA: G_CHECK_ADDRESS LIKE SZAD_FIELD-FLAG VALUE 'X',       "*131i
      RETURNCODE LIKE SZAD_FIELD-RETURNCODE.
DATA: BEGIN OF TEL_TABLE OCCURS 0.
        INCLUDE STRUCTURE ADTEL.
DATA: END OF TEL_TABLE.
DATA: BEGIN OF ERROR_TABLE OCCURS 0.
        INCLUDE STRUCTURE ADDR_ERROR.
DATA: END OF ERROR_TABLE.
DATA: ADRNR LIKE BAPI4001_1-ADDR_NO,
      MAPPE(12),
      QID   LIKE APQI-QID.
*-----------------------------------------------------------------------
* Constants
*-----------------------------------------------------------------------
CONSTANTS: C_TRUE(1)           TYPE C  VALUE 'X',
           C_FALSE(1)          TYPE C  VALUE ' ',
           C_TCODE             LIKE SY-TCODE VALUE 'ME22',
           C_FILETYPE(10)      TYPE C  VALUE 'ASC',
           C_0(1)              TYPE C VALUE '0',
           C_1(1)              TYPE C VALUE '1',
           C_2(1)              TYPE C VALUE '2',
           C_X(1)              TYPE C VALUE 'X',
           C_AMPER(1)          TYPE C VALUE '&',
           C_CHAR_B(1)         TYPE C VALUE 'B',
           C_SLSH(1)           TYPE C VALUE '/',
           C_UPDATE(1)         TYPE C VALUE 'A',
           C_XD01(4)           TYPE C VALUE 'XD01'.
*-----------------------------------------------------------------------
* Work Field Area
*-----------------------------------------------------------------------
DATA: W_VALIDATION_ERRORS(1) TYPE C,
      L_FIRST,
      W_DATE(10)    TYPE C,
      W_GROUP       LIKE BGR00-GROUP,
      W_N           TYPE I,
      W_LINES       TYPE I,
      W_SEQ_NO      TYPE I  VALUE 0,
      W_READ_CTR    TYPE P,
      W_PROCESS_CTR TYPE P,
      W_ERROR_CTR   TYPE P,
      W_TXT(110)    TYPE C,
      E_GROUP_OPENED,
      SMALLLOG(1)   TYPE C VALUE  'X',
      UC_FILENAME   TYPE STRING,
      ERRFILE       TYPE STRING.
*-----------------------------------------------------------------------
* Selection Screen
*-----------------------------------------------------------------------
SELECTION-SCREEN: BEGIN OF BLOCK A WITH FRAME TITLE TEXT-004.
PARAMETERS: P_HDRDEL(1) TYPE N,
            P_FILENM    LIKE RLGRAP-FILENAME  OBLIGATORY,
            P_ERFILE    LIKE RLGRAP-FILENAME.
PARAMETERS: P_TESTMD    AS   CHECKBOX DEFAULT 'X'.
SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN: END OF BLOCK A.
*-----------------------------------------------------------------------
*  At Selection Screen Event
*-----------------------------------------------------------------------
AT SELECTION-SCREEN ON VALUE-REQUEST FOR P_FILENM.
* Allow user to browse for file
  PERFORM GET_FILE_NAME CHANGING P_FILENM.
AT SELECTION-SCREEN ON VALUE-REQUEST FOR P_ERFILE.
* Allow user to browse for file
  PERFORM GET_FILE_NAME CHANGING P_ERFILE.
*----------------------------------------------------------------------*
*   at selection screen                                                *
*----------------------------------------------------------------------*
AT SELECTION-SCREEN ON P_ERFILE.
  IF P_TESTMD IS INITIAL AND P_ERFILE IS INITIAL.
    MESSAGE E398(00) WITH 'Please enter error filename'.
  ENDIF.
*-----------------------------------------------------------------------
* Top of Page Event
*-----------------------------------------------------------------------
TOP-OF-PAGE.
*
** Print standard company header
*
*  PERFORM print_report_header.
*
** Print column headings
*
*  FORMAT COLOR COL_HEADING ON.
*
*  WRITE: /001 text-004,
*          017 text-005,
*          040 text-006.
*
*  ULINE.
*
*  FORMAT COLOR COL_NORMAL ON.
*-----------------------------------------------------------------------
* Initialization Event
*-----------------------------------------------------------------------
INITIALIZATION.
  PERFORM INITIALISATION.
*-----------------------------------------------------------------------
* Start-of-selection Event
*-----------------------------------------------------------------------
START-OF-SELECTION.
  WRITE SY-DATUM TO W_DATE DD/MM/YYYY.
* Upload file into internal table. The file should be tab delimited
* In excel save the file with extension .TXT
  PERFORM READ_FILE_DATA.
* Validate the input file
  PERFORM VALIDATE_FILE_DATA.
* Create Vendor Records
  IF P_TESTMD = C_FALSE .
*   Change Vendors
    PERFORM CHANGE_VENDOR.
    PERFORM DOWNLOAD_ERROR.
  ENDIF.
*-----------------------------------------------------------------------
* End of Selection Event
*-----------------------------------------------------------------------
END-OF-SELECTION.
*  Write report footer or send 'No Data' message
*  PERFORM print_report_footer.
*-----------------------------------------------------------------------
* Includes
*-----------------------------------------------------------------------
*  INCLUDE fzxxi001. "Routine for printing the report header
*  INCLUDE fzxxi002. "Routine for printing the report footer
*----------------------------------------------------------------------*
*       Form  A0100_INITIALISATION
*----------------------------------------------------------------------*
*       Initialise variables and internal tables.
*----------------------------------------------------------------------*
FORM INITIALISATION.
  REFRESH: T_FILEDATA,
           T_VEND.
  MOVE: 'VEND_'  TO MAPPE,
        SY-UZEIT TO MAPPE+5(6).
ENDFORM.                    " A0100_INITIALISATION
*----------------------------------------------------------------------*
*       Form  A0200_READ_FILE_DATA
*----------------------------------------------------------------------*
*       Read and store the data from the file.
*----------------------------------------------------------------------*
FORM READ_FILE_DATA.
  DATA: L_LINE TYPE I,
        SUBRC  LIKE SY-SUBRC.
* Display program execution progress.
* TEXT-002 : Read file data.............
  CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
    EXPORTING
      TEXT   = TEXT-002
    EXCEPTIONS
      OTHERS = 1.
* Upload data file from presentation server
  UC_FILENAME = P_FILENM.
  PERFORM WS_UPLOAD TABLES   T_VEND
                    USING    UC_FILENAME
                             C_FILETYPE
                             'X'
                    CHANGING SUBRC.
* SORT t_vend BY lifnr.
* Delete unwanted header lines
  IF NOT P_HDRDEL IS INITIAL.
    DELETE T_VEND TO P_HDRDEL.
  ENDIF.
* Delete any other blank line
  DELETE T_VEND  WHERE LIFNR EQ SPACE
                    AND DEFLT_COMM  EQ SPACE.
  DESCRIBE TABLE T_VEND LINES L_LINE.
  IF P_HDRDEL > L_LINE.
    WRITE: / 'No of Header Lines declared are more than total lines'.
    EXIT.
  ENDIF.
  WRITE: / 'No of Lines read and stored:', L_LINE.
ENDFORM.                    " A0200_READ_FILE_DATA
*---------------------------------------------------------------------*
*       FORM validate_file_data                                       *
*---------------------------------------------------------------------*
*       ........                                                      *
*---------------------------------------------------------------------*
FORM VALIDATE_FILE_DATA.
  STATICS: L_FLAG(1) TYPE C,
           L_REC     LIKE SY-TABIX,
           L_TABIX   LIKE SY-TABIX.
* Display program execution progress.
* TEXT-004 : Validate the file data ........
  CLEAR: L_FLAG, L_TABIX.
  CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
    EXPORTING
      TEXT   = TEXT-004
    EXCEPTIONS
      OTHERS = 1.
  SKIP 2.
  WRITE: / 'Validating vendor''s data' COLOR COL_HEADING.
  SKIP 1.
  LOOP AT T_VEND.
    L_TABIX = SY-TABIX.
    TRANSLATE T_VEND TO UPPER CASE.
    CALL FUNCTION 'CONVERSION_EXIT_ALPHA_INPUT'
      EXPORTING
        INPUT  = T_VEND-LIFNR
      IMPORTING
        OUTPUT = T_VEND-LIFNR.
    MODIFY T_VEND INDEX L_TABIX.
  ENDLOOP.
* Get vendor's details into internal tables
  IF NOT T_VEND IS INITIAL.
    REFRESH IT_TSAC.
    SELECT COMM_TYPE INTO TABLE IT_TSAC
                          FROM TSAC
                          FOR ALL ENTRIES IN T_VEND
                          WHERE COMM_TYPE = T_VEND-DEFLT_COMM.
    REFRESH IT_LFA1.
    SELECT LIFNR LAND1 ADRNR INTO TABLE IT_LFA1
                                  FROM LFA1
                                  FOR ALL ENTRIES IN T_VEND
                                  WHERE LIFNR = T_VEND-LIFNR.
  ENDIF.
  L_REC = P_HDRDEL.
  LOOP AT T_VEND.
    L_TABIX = SY-TABIX.
    CLEAR W_TXT.
    L_REC = L_REC + 1.
*   check if vendor exist.
    READ TABLE IT_LFA1 WITH TABLE KEY LIFNR = T_VEND-LIFNR.
    IF SY-SUBRC NE 0.
      CLEAR W_TXT.
      W_VALIDATION_ERRORS = C_TRUE.
      CONCATENATE 'Error-Vendor' T_VEND-LIFNR 'does not exist'
                   INTO W_TXT SEPARATED BY SPACE.
      WRITE: / 'Row No:', L_REC, W_TXT.
    ENDIF.
*   Check standard communication type
    READ TABLE IT_TSAC WITH TABLE KEY COMM_TYPE = T_VEND-DEFLT_COMM.
    IF SY-SUBRC NE 0.
      CLEAR W_TXT.
      W_VALIDATION_ERRORS = C_TRUE.
      CONCATENATE 'Error-Com' T_VEND-DEFLT_COMM 'does not exist'
                   INTO W_TXT SEPARATED BY SPACE.
      WRITE: / 'Row No:', L_REC, W_TXT.
    ENDIF.
*   Check Telephone number
    PERFORM CHECK_TELEPHONE.
    LOOP AT ERROR_TABLE.
      SELECT SINGLE * FROM T100 WHERE SPRSL = SY-LANGU
                                AND   ARBGB = ERROR_TABLE-MSG_ID
                                AND   MSGNR = ERROR_TABLE-MSG_NUMBER.
      IF SY-SUBRC = 0.
        W_TXT = T100-TEXT.
        IF W_TXT CS '&1'.
          REPLACE '&1' WITH ERROR_TABLE-MSG_VAR1 INTO W_TXT.
          REPLACE '&2' WITH ERROR_TABLE-MSG_VAR2 INTO W_TXT.
          REPLACE '&3' WITH ERROR_TABLE-MSG_VAR3 INTO W_TXT.
          REPLACE '&4' WITH ERROR_TABLE-MSG_VAR4 INTO W_TXT.
        ELSE.
          REPLACE '&'  WITH ERROR_TABLE-MSG_VAR1 INTO W_TXT.
          REPLACE '&'  WITH ERROR_TABLE-MSG_VAR2 INTO W_TXT.
          REPLACE '&'  WITH ERROR_TABLE-MSG_VAR3 INTO W_TXT.
          REPLACE '&'  WITH ERROR_TABLE-MSG_VAR4 INTO W_TXT.
        ENDIF.
        CONDENSE W_TXT.
      ELSE.
        W_TXT = ERROR_TABLE.
      ENDIF.
      IF ERROR_TABLE-MSG_TYPE = 'E' OR ERROR_TABLE-MSG_TYPE = 'A'.
        W_VALIDATION_ERRORS = C_TRUE.
        CONCATENATE 'Error-'   W_TXT INTO W_TXT.
      ELSE.
        CONCATENATE 'Warning-' W_TXT INTO W_TXT.
      ENDIF.
      WRITE: / 'Row No:', L_REC, W_TXT.
    ENDLOOP.
    REFRESH ERROR_TABLE.
*   For Purchasing view
    IF NOT T_VEND-EKORG IS INITIAL.
      SELECT SINGLE * FROM LFM1 WHERE LIFNR = T_VEND-LIFNR
                                  AND EKORG = T_VEND-EKORG.
      IF SY-SUBRC NE 0.     "Create
*       Check Order Currency - cannot be blank if create Purchasing View
        IF T_VEND-WAERS IS INITIAL.
          CLEAR W_TXT.
          W_VALIDATION_ERRORS = C_TRUE.
          W_TXT = 'Error-Order Currency cannot be blank if Create' &
                  'Purchasing View'.
          WRITE: / 'Row No:', L_REC, W_TXT.
        ENDIF.
*       Check Payment Terms - cannot be blank if create Purchasing View
        IF T_VEND-ZTERM IS INITIAL.
          CLEAR W_TXT.
          W_VALIDATION_ERRORS = C_TRUE.
          W_TXT = 'Error-Payment Terms cannot be blank if Create' &
                  'Purchasing View'.
          WRITE: / 'Row No:', L_REC, W_TXT.
        ENDIF.
*       Check GR-based invoice inverification - cannot be blank if
*                                           create Purchasing View
        IF T_VEND-WEBRE IS INITIAL.
          CLEAR W_TXT.
          W_VALIDATION_ERRORS = C_TRUE.
          W_TXT = 'Error-GR Based Inv Inveri cannot be blank if Create'
                & 'Purchasing View'.
          WRITE: / 'Row No:', L_REC, W_TXT.
        ENDIF.
      ENDIF.
    ELSE.
*     Purchasing Org can not be blank if want to create purchasing view
      IF T_VEND-WAERS NE SPACE OR T_VEND-ZTERM NE SPACE OR
         T_VEND-VERKF NE SPACE OR T_VEND-WEBRE NE SPACE.
        CLEAR W_TXT.
        W_VALIDATION_ERRORS = C_TRUE.
        W_TXT = 'Error-Purchasing Organization is blank =>' &
                'cannot Create Purchasing View'.
        WRITE: / 'Row No:', L_REC, W_TXT.
      ENDIF.
    ENDIF.    "For Purchasing view
    IF W_VALIDATION_ERRORS = C_TRUE.
      CLEAR W_VALIDATION_ERRORS.
      APPEND T_VEND TO IT_ERROR.
      DELETE T_VEND INDEX L_TABIX.
    ENDIF.
  ENDLOOP.
  IF IT_ERROR[] IS INITIAL.
    SKIP 2.
    WRITE: / 'No errors found'.
    SKIP 2.
  ENDIF.
ENDFORM.                    " A0400_VALIDATE_FILE_DATA
*----------------------------------------------------------------------*
*   Form CHECK_TELEPHONE
*----------------------------------------------------------------------*
*   Validate Telephone number
*----------------------------------------------------------------------*
FORM CHECK_TELEPHONE.
  CLEAR IT_LFA1.
  READ TABLE IT_LFA1 WITH TABLE KEY LIFNR = T_VEND-LIFNR.
  CALL FUNCTION 'ADDR_COMM_GET'
       EXPORTING
*           address_handle    = space
            ADDRESS_NUMBER    = IT_LFA1-ADRNR
            TABLE_TYPE        = 'ADTEL'
       IMPORTING
            RETURNCODE        = RETURNCODE
       TABLES
            COMM_TABLE        = TEL_TABLE
            ERROR_TABLE       = ERROR_TABLE
       EXCEPTIONS
            PARAMETER_ERROR   = 1
            ADDRESS_NOT_EXIST = 2
            INTERNAL_ERROR    = 3
            OTHERS            = 99.
  IF SY-SUBRC = 0.
    REFRESH ERROR_TABLE.
    IF TEL_TABLE[] IS INITIAL.
      TEL_TABLE-COUNTRY    = IT_LFA1-LAND1.
      TEL_TABLE-TEL_NUMBER = T_VEND-TEL.
      TEL_TABLE-UPDATEFLAG = 'I'.
      APPEND TEL_TABLE.
    ELSE.
      LOOP AT TEL_TABLE.
        TEL_TABLE-TEL_NUMBER = T_VEND-TEL.
        TEL_TABLE-UPDATEFLAG = 'U'.
        MODIFY TEL_TABLE.
      ENDLOOP.
    ENDIF.
    CALL FUNCTION 'ADDR_COMM_MAINTAIN'
         EXPORTING
*             address_handle    = g_address_handle   "blank
              ADDRESS_NUMBER    = IT_LFA1-ADRNR
              TABLE_TYPE        = 'ADTEL'
              CHECK_ADDRESS     = G_CHECK_ADDRESS
         IMPORTING
              RETURNCODE        =  RETURNCODE
         TABLES
              COMM_TABLE        =  TEL_TABLE
              ERROR_TABLE       =  ERROR_TABLE
         EXCEPTIONS
              PARAMETER_ERROR   = 1
              ADDRESS_NOT_EXIST = 2
              INTERNAL_ERROR    = 3
              OTHERS            = 99.
  ELSE.
    REFRESH ERROR_TABLE.
  ENDIF.
  REFRESH: TEL_TABLE,
           T_BAPIAD1VL  ,
           T_BAPIADSMTP ,
           T_BAPICOMREM ,
           TX_BAPIAD1VLX,
           TX_BAPIADTELX,
           TX_BAPIADFAXX,
           TX_BAPIADSMTX,
           TX_BAPICOMREX,
           T_RET.
  CLEAR: TEL_TABLE,
         T_BAPIAD1VL  ,
         T_BAPIADSMTP ,
         T_BAPICOMREM ,
         TX_BAPIAD1VLX,
         TX_BAPIADTELX,
         TX_BAPIADFAXX,
         TX_BAPIADSMTX,
         TX_BAPICOMREX.
ENDFORM.                    "check_telephone
*----------------------------------------------------------------------*
*        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 NOT FVAL IS INITIAL.
    CLEAR BDCDATA.
    BDCDATA-FNAM = FNAM.
    BDCDATA-FVAL = FVAL.
    APPEND BDCDATA.
  ENDIF.
ENDFORM.                    "bdc_field
*---------------------------------------------------------------------*
*       FORM get_file_name                                            *
*---------------------------------------------------------------------*
*       ........                                                      *
*---------------------------------------------------------------------*
FORM GET_FILE_NAME CHANGING P_FILE LIKE RLGRAP-FILENAME.
*BEGIN SYDK980765
  DATA: L_FILE  TYPE STRING,
        T_FILES TYPE FILETABLE,
        L_SUBRC TYPE I,
        L_TITLE TYPE STRING VALUE 'File System for Pres. Server'.
  L_FILE = P_FILE.
  CALL METHOD CL_GUI_FRONTEND_SERVICES=>FILE_OPEN_DIALOG
    EXPORTING
      WINDOW_TITLE            = L_TITLE
      DEFAULT_FILENAME        = L_FILE
    CHANGING
      FILE_TABLE              = T_FILES
      RC                      = L_SUBRC
    EXCEPTIONS
      FILE_OPEN_DIALOG_FAILED = 1
      CNTL_ERROR              = 2
      ERROR_NO_GUI            = 3
      OTHERS                  = 4.
  READ TABLE T_FILES INDEX 1 INTO P_FILE.
*  CALL FUNCTION 'WS_FILENAME_GET'
*    EXPORTING
*      def_filename     = space
*      def_path         = p_file
*      mask             = ' ,.,..'
*      mode             = 's'
*    IMPORTING
*      filename         = p_file
*    EXCEPTIONS
*      inv_winsys       = 1
*      no_batch         = 2
*      selection_cancel = 3
*      selection_error  = 4
*      OTHERS           = 5.
*END SYDK980765
ENDFORM.                    "get_file_name
*---------------------------------------------------------------------*
*       FORM CHANGE_VENDOR                                            *
*---------------------------------------------------------------------*
* Change Vendor details                                               *
*---------------------------------------------------------------------*
FORM CHANGE_VENDOR.
* Display program execution progress.
* TEXT-005 : Create the BDC session ........
  CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
    EXPORTING
      TEXT   = TEXT-005
    EXCEPTIONS
      OTHERS = 1.
* GET VENDOR'S COMPANY
  IF NOT T_VEND[] IS INITIAL.
    REFRESH IT_KBUKA.
    SELECT LIFNR BUKRS INTO TABLE IT_KBUKA
                            FROM K_KBUKA
                            FOR ALL ENTRIES IN T_VEND
                            WHERE LIFNR = T_VEND-LIFNR.
*   BDC_OPEN_GROUP
    CALL FUNCTION 'BDC_OPEN_GROUP'
      EXPORTING
        CLIENT              = SY-MANDT
        GROUP               = MAPPE
        KEEP                = 'X'
        USER                = SY-UNAME
      IMPORTING
        QID                 = QID
      EXCEPTIONS
        CLIENT_INVALID      = 1
        DESTINATION_INVALID = 2
        GROUP_INVALID       = 3
        GROUP_IS_LOCKED     = 4
        HOLDDATE_INVALID    = 5
        INTERNAL_ERROR      = 6
        QUEUE_ERROR         = 7
        RUNNING             = 8
        SYSTEM_LOCK_ERROR   = 9
        USER_INVALID        = 10
        OTHERS              = 11.
  ENDIF.
* Call BAPI to update vendor addr or BDC to create/chg purchasing view
  LOOP AT T_VEND.
*   Update Vendor Address
    PERFORM MAINTAIN_EMAIL.
*   Change or create Vendor Purchasing View
    SELECT SINGLE * FROM LFM1 WHERE LIFNR = T_VEND-LIFNR
                                AND EKORG = T_VEND-EKORG.
    IF SY-SUBRC = 0.
      PERFORM CHANGE_VENDOR_PURCH.   "Change
    ELSE.
      PERFORM CREATE_VENDOR_PURCH.   "Create
    ENDIF.
  ENDLOOP.
* BDC_CLOSE_GROUP
  IF SY-SUBRC = 0.
    CALL FUNCTION 'BDC_CLOSE_GROUP'
      EXCEPTIONS
        NOT_OPEN    = 1
        QUEUE_ERROR = 2
        OTHERS      = 3.
    PERFORM RELEASE_BDC_SESSION.
  ENDIF.
ENDFORM.                    "change_vendor
*&---------------------------------------------------------------------*
*&      FORM CHANGE_VENDOR_PURC
*&---------------------------------------------------------------------*
*  Change the data in Purchasing View - Order currency, Payment terms
*  Contact person and GR-based invoice inverification
*----------------------------------------------------------------------*
FORM CHANGE_VENDOR_PURCH.
  REFRESH BDCDATA.
  PERFORM BDC_DYNPRO   USING 'SAPMF02K'           '0101'.
  PERFORM BDC_FIELD    USING 'RF02K-LIFNR'        T_VEND-LIFNR.
  PERFORM BDC_FIELD    USING 'RF02K-EKORG'        T_VEND-EKORG.
  PERFORM BDC_FIELD    USING 'RF02K-D0310'        'X'.  "PURCHASING
  PERFORM BDC_FIELD    USING 'BDC_OKCODE'         '/00'.
  PERFORM BDC_DYNPRO   USING 'SAPMF02K'           '0310'.
  PERFORM BDC_FIELD    USING 'LFM1-WAERS'         T_VEND-WAERS.
  PERFORM BDC_FIELD    USING 'LFM1-ZTERM'         T_VEND-ZTERM.
  PERFORM BDC_FIELD    USING 'LFM1-VERKF'         T_VEND-VERKF.
  PERFORM BDC_FIELD    USING 'LFM1-WEBRE'         T_VEND-WEBRE.
  PERFORM BDC_FIELD    USING 'BDC_OKCODE'         '=UPDA'.
  PERFORM BDC_TRANSACTION USING 'XK02'.
ENDFORM.                    " create_vendor_transaction
*&---------------------------------------------------------------------*
*&      FORM CREATE_VENDOR_PURC
*&---------------------------------------------------------------------*
*  Create the data in Purchasing View - Order currency, Payment terms
*  Contact person and GR-based invoice inverification
*----------------------------------------------------------------------*
FORM CREATE_VENDOR_PURCH.
  REFRESH BDCDATA.
  PERFORM BDC_DYNPRO   USING 'SAPMF02K'           '0100'.
  PERFORM BDC_FIELD    USING 'RF02K-LIFNR'        T_VEND-LIFNR.
  PERFORM BDC_FIELD    USING 'RF02K-EKORG'        T_VEND-EKORG.
  PERFORM BDC_FIELD    USING 'BDC_OKCODE'         '/00'.
  PERFORM BDC_DYNPRO   USING 'SAPMF02K'           '0310'.
  PERFORM BDC_FIELD    USING 'LFM1-WAERS'         T_VEND-WAERS.
  PERFORM BDC_FIELD    USING 'LFM1-ZTERM'         T_VEND-ZTERM.
  PERFORM BDC_FIELD    USING 'LFM1-VERKF'         T_VEND-VERKF.
  PERFORM BDC_FIELD    USING 'LFM1-WEBRE'         T_VEND-WEBRE.
  PERFORM BDC_FIELD    USING 'BDC_OKCODE'         '=UPDA'.
  PERFORM BDC_TRANSACTION USING 'XK01'.
ENDFORM.                    "CREATE_VENDOR_PURCH
*----------------------------------------------------------------------*
*        Start new transaction according to parameters                 *
*----------------------------------------------------------------------*
FORM BDC_TRANSACTION USING TCODE.
* BDC_INSERT
  CALL FUNCTION 'BDC_INSERT'
    EXPORTING
      TCODE            = TCODE
    TABLES
      DYNPROTAB        = BDCDATA
    EXCEPTIONS
      INTERNAL_ERROR   = 1
      NOT_OPEN         = 2
      QUEUE_ERROR      = 3
      TCODE_INVALID    = 4
      PRINTING_INVALID = 5
      POSTING_INVALID  = 6
      OTHERS           = 7.
  REFRESH BDCDATA.
ENDFORM.                    "bdc_transaction
*&---------------------------------------------------------------------*
*&      Form  RELEASE_BDC_SESSION
*&---------------------------------------------------------------------*
*  Release BDC session automatically
*----------------------------------------------------------------------*
FORM RELEASE_BDC_SESSION.
  DATA: V_BDC_JOB_NAME(32) TYPE C,
        V_BDC_JOB_NUMB(8)  TYPE C.
* Create a job to execute the BDC session (RSBDCBTC)
  V_BDC_JOB_NAME = MAPPE.
  CALL FUNCTION 'JOB_OPEN'
    EXPORTING
      JOBGROUP         = TEXT-007
      JOBNAME          = V_BDC_JOB_NAME
    IMPORTING
      JOBCOUNT         = V_BDC_JOB_NUMB
    EXCEPTIONS
      ALREADY_LOCKED   = 1
      JOBCOUNT_CANTGEN = 2
      JOBGROUP_MISSING = 3
      JOBNAME_MISSING  = 4
      LOCK_FAILED      = 5
      OLD_DATABASE     = 6
      PLAN_NOAUTH      = 7
      START_PAST       = 8
      OTHERS           = 99.
* Release BDC session thru job
  SUBMIT RSBDCBTC
         USER SY-UNAME
         VIA JOB    V_BDC_JOB_NAME
             NUMBER V_BDC_JOB_NUMB
         WITH   QUEUE_ID               = QID
         WITH   MAPPE                  = MAPPE
         WITH   MODUS                  = 'N'
         WITH   LOGALL                 = ''
         AND    RETURN.
* Release the job
  CALL FUNCTION 'JOB_CLOSE'
    EXPORTING
      JOBCOUNT             = V_BDC_JOB_NUMB
      JOBNAME              = V_BDC_JOB_NAME
      STRTIMMED            = 'X'
    EXCEPTIONS
      ALREADY_LOCKED       = 1
      JOBCOUNT_CANTGEN     = 2
      JOBGROUP_MISSING     = 3
      JOBNAME_MISSING      = 4
      LOCK_FAILED          = 5
      OLD_DATABASE         = 6
      PLAN_NOAUTH          = 7
      START_PAST           = 8
      CANT_START_IMMEDIATE = 9
      JOB_CLOSE_FAILED     = 10
      OTHERS               = 99.
ENDFORM.                    "RELEASE_BDC_SESSION
*&---------------------------------------------------------------------*
*&      Form  download_error
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
FORM DOWNLOAD_ERROR .
  DATA SUBRC LIKE SY-SUBRC.
* Download error file
  ERRFILE = P_ERFILE.
  PERFORM WS_DOWNLOAD TABLES   IT_ERROR
                      USING    SPACE
                               ERRFILE
                               C_FILETYPE
                               'X'
                               'X'
                      CHANGING SUBRC.
ENDFORM.                    " download_error
*&---------------------------------------------------------------------*
*&      Form  maintain_email
*&---------------------------------------------------------------------*
*  Maintain Vendor Address details
*----------------------------------------------------------------------*
FORM MAINTAIN_EMAIL.
  STATICS: L_LIFNR LIKE BAPI4001_1-OBJKEY.
  L_LIFNR = T_VEND-LIFNR.
  CLEAR IT_LFA1.
  READ TABLE IT_LFA1 WITH TABLE KEY LIFNR = T_VEND-LIFNR.
  CALL FUNCTION 'BAPI_ADDRESSORG_GETDETAIL'
    EXPORTING
      OBJ_TYPE       = 'LFA1'
      OBJ_ID         = L_LIFNR
    IMPORTING
      ADDRESS_NUMBER = ADRNR
    TABLES
      BAPIAD1VL      = T_BAPIAD1VL
      BAPIADTEL      = T_BAPIADTEL
      BAPIADFAX      = T_BAPIADFAX
      BAPIADSMTP     = T_BAPIADSMTP
      BAPICOMREM     = T_BAPICOMREM
      RETURN         = T_RET.
  REFRESH T_RET.
* Update Standard Communication Method field
  LOOP AT T_BAPIAD1VL.
    T_BAPIAD1VL-COMM_TYPE = T_VEND-DEFLT_COMM.
    MODIFY T_BAPIAD1VL.
  ENDLOOP.
  IF SY-SUBRC EQ 0.
    TX_BAPIAD1VLX-COMM_TYPE  = 'X'.
    TX_BAPIAD1VLX-UPDATEFLAG = 'U'.
    APPEND TX_BAPIAD1VLX.
  ENDIF.
* Update Telephone number field
  LOOP AT T_BAPIADTEL.
    T_BAPIADTEL-TELEPHONE = T_VEND-TEL.
    MODIFY T_BAPIADTEL.
  ENDLOOP.
  IF SY-SUBRC NE 0.   "Create
    T_BAPIADTEL-COUNTRY    = IT_LFA1-LAND1.
    T_BAPIADTEL-COUNTRYISO = IT_LFA1-LAND1.
    T_BAPIADTEL-STD_NO     = 'X'.
    T_BAPIADTEL-HOME_FLAG  = 'X'.
    T_BAPIADTEL-CONSNUMBER = '001'.
    T_BAPIADTEL-TELEPHONE  = T_VEND-TEL.
    APPEND T_BAPIADTEL.
    TX_BAPIADTELX-HOME_FLAG  = 'X'.
    TX_BAPIADTELX-CONSNUMBER = 'X'.
    TX_BAPIADTELX-COUNTRY    = 'X'.
    TX_BAPIADTELX-COUNTRYISO = 'X'.
    TX_BAPIADTELX-STD_NO     = 'X'.
    TX_BAPIADTELX-UPDATEFLAG = 'I'.
  ELSE.              "Change
    TX_BAPIADTELX-UPDATEFLAG = 'U'.
  ENDIF.
  TX_BAPIADTELX-TELEPHONE = 'X'.
  APPEND TX_BAPIADTELX.
* Update Fax number field
  LOOP AT T_BAPIADFAX.
    T_BAPIADFAX-FAX = T_VEND-FAX.
    MODIFY T_BAPIADFAX.
  ENDLOOP.
  IF SY-SUBRC NE 0.     "Create
    T_BAPIADFAX-COUNTRY      = IT_LFA1-LAND1.
    T_BAPIADFAX-COUNTRYISO   = IT_LFA1-LAND1.
    T_BAPIADFAX-STD_NO       = 'X'.
    T_BAPIADFAX-HOME_FLAG    = 'X'.
    T_BAPIADFAX-CONSNUMBER   = '001'.
    T_BAPIADFAX-FAX          = T_VEND-FAX.
    APPEND T_BAPIADFAX.
    TX_BAPIADFAXX-STD_NO     = 'X'.
    TX_BAPIADFAXX-HOME_FLAG  = 'X'.
    TX_BAPIADFAXX-COUNTRY    = 'X'.
    TX_BAPIADFAXX-COUNTRYISO = 'X'.
    TX_BAPIADFAXX-CONSNUMBER = 'X'.
    TX_BAPIADFAXX-UPDATEFLAG = 'I'.
  ELSE.                 "Change
    TX_BAPIADFAXX-UPDATEFLAG = 'U'.
  ENDIF.
  TX_BAPIADFAXX-FAX       = 'X'.
  APPEND TX_BAPIADFAXX.
* Update Email address field
  LOOP AT T_BAPIADSMTP.
    T_BAPIADSMTP-E_MAIL     = T_VEND-EMAIL.
    MODIFY T_BAPIADSMTP.
  ENDLOOP.
  IF SY-SUBRC NE 0.        "Create
    T_BAPIADSMTP-STD_NO      = 'X'.
    T_BAPIADSMTP-HOME_FLAG   = 'X'.
    T_BAPIADSMTP-CONSNUMBER  = '001'.
    T_BAPIADSMTP-E_MAIL      = T_VEND-EMAIL.
    APPEND T_BAPIADSMTP.
    TX_BAPIADSMTX-STD_NO     = 'X'.
    TX_BAPIADSMTX-HOME_FLAG  = 'X'.
    TX_BAPIADSMTX-CONSNUMBER = 'X'.
    TX_BAPIADSMTX-UPDATEFLAG = 'I'.
  ELSE.                    "Change
    TX_BAPIADSMTX-UPDATEFLAG = 'U'.
  ENDIF.
  TX_BAPIADSMTX-E_MAIL     = 'X'.
  APPEND TX_BAPIADSMTX.
* Update the Available Communication type
* Email address
  LOOP AT T_BAPICOMREM WHERE COMM_TYPE = 'INT'.
    EXIT.
  ENDLOOP.
  IF SY-SUBRC NE 0.
    T_BAPICOMREM-COMM_TYPE   = 'INT'.
    T_BAPICOMREM-LANGU       = SY-LANGU.
    T_BAPICOMREM-LANGU_ISO   = SY-LANGU.
    T_BAPICOMREM-CONSNUMBER  = '001'.
    APPEND T_BAPICOMREM.
    TX_BAPICOMREX-COMM_TYPE  = 'X'.
    TX_BAPICOMREX-LANGU      = 'X'.
    TX_BAPICOMREX-LANGU_ISO  = 'X'.
    TX_BAPICOMREX-CONSNUMBER = 'X'.
    TX_BAPICOMREX-UPDATEFLAG = 'I'.
    APPEND TX_BAPICOMREX.
  ENDIF.
* Fax
  LOOP AT T_BAPICOMREM WHERE COMM_TYPE = 'FAX'.
    EXIT.
  ENDLOOP.
  IF SY-SUBRC NE 0.
    T_BAPICOMREM-COMM_TYPE   = 'FAX'.
    T_BAPICOMREM-LANGU       = SY-LANGU.
    T_BAPICOMREM-LANGU_ISO   = SY-LANGU.
    T_BAPICOMREM-CONSNUMBER  = '001'.
    APPEND T_BAPICOMREM.
    TX_BAPICOMREX-COMM_TYPE  = 'X'.
    TX_BAPICOMREX-LANGU      = 'X'.
    TX_BAPICOMREX-LANGU_ISO  = 'X'.
    TX_BAPICOMREX-CONSNUMBER = 'X'.
    TX_BAPICOMREX-UPDATEFLAG = 'I'.
    APPEND TX_BAPICOMREX.
  ENDIF.
* Telephone
  LOOP AT T_BAPICOMREM WHERE COMM_TYPE = 'TEL'.
    EXIT.
  ENDLOOP.
  IF SY-SUBRC NE 0.
    T_BAPICOMREM-COMM_TYPE   = 'TEL'.
    T_BAPICOMREM-LANGU       = SY-LANGU.
    T_BAPICOMREM-LANGU_ISO   = SY-LANGU.
    T_BAPICOMREM-CONSNUMBER  = '001'.
    APPEND T_BAPICOMREM.
    TX_BAPICOMREX-COMM_TYPE  = 'X'.
    TX_BAPICOMREX-LANGU      = 'X'.
    TX_BAPICOMREX-LANGU_ISO  = 'X'.
    TX_BAPICOMREX-CONSNUMBER = 'X'.
    TX_BAPICOMREX-UPDATEFLAG = 'I'.
    APPEND TX_BAPICOMREX.
  ENDIF.
* Call the BAPI to update the Vendor address
  CALL FUNCTION 'BAPI_ADDRESSORG_CHANGE'
    EXPORTING
      OBJ_TYPE     = 'LFA1'
      OBJ_ID       = L_LIFNR
      SAVE_ADDRESS = 'X'
    TABLES
      BAPIAD1VL    = T_BAPIAD1VL
      BAPIADTEL    = T_BAPIADTEL
      BAPIADFAX    = T_BAPIADFAX
      BAPIADSMTP   = T_BAPIADSMTP
      BAPICOMREM   = T_BAPICOMREM
      BAPIAD1VL_X  = TX_BAPIAD1VLX
      BAPIADTEL_X  = TX_BAPIADTELX
      BAPIADFAX_X  = TX_BAPIADFAXX
      BAPIADSMT_X  = TX_BAPIADSMTX
      BAPICOMRE_X  = TX_BAPICOMREX
      RETURN       = T_RET.
  REFRESH: T_BAPIAD1VL  ,
           T_BAPIADTEL  ,
           T_BAPIADFAX  ,
           T_BAPIADSMTP ,
           T_BAPICOMREM ,
           TX_BAPIAD1VLX,
           TX_BAPIADTELX,
           TX_BAPIADFAXX,
           TX_BAPIADSMTX,
           TX_BAPICOMREX,
           T_RET.
  CLEAR: T_BAPIAD1VL  ,
         T_BAPIADSMTP ,
         T_BAPICOMREM ,
         TX_BAPIAD1VLX,
         TX_BAPIADTELX,
         TX_BAPIADFAXX,
         TX_BAPIADSMTX,
         TX_BAPICOMREX.
  CALL FUNCTION 'BAPI_TRANSACTION_COMMIT'.
ENDFORM.                    " maintain_email
INCLUDE ZZX0002F.
  • No labels

2 Comments

  1. I was looking into this coding but I can't find out where the LFA1 table is updated.

    with the SPAN

    Unknown macro: { font-family}

    BAPI_ADDRESSORG_CHANGE only the adress is updated and not the lfa1. all standard sap transactions still refer to the lfa1 data and not to the address data

    kind regards

    arthur

  2. the above code was really good and helped me alot

    cheers~

    Sreekanth