会计凭证批量导入

通过BAPI实现数据检查和导入:

1、BAPI_ACC_DOCUMENT_CHECK-数据检查；

2、GD_DOCUMENTHEADER-数据导入

3、参数P_FNAME为数据表，包含项目、科目、成本中心、订单、描述，参数Q_FNAME为数据表，包含项目、币别、金额；

4、如执行后成功产生会计凭证，但FB03无法找到，需最后加语句 COMMIT WORK.

[@more@]

*--------------------------------------------------------------------------------*
* PROJECT NAME: MOTIC
* PROGRAM TITLE:
* PROGRAM ID/NAME: ZMIGFK051 DATE WRITTEN: 2009.08.31
* AUTHOR'S NAME: Harson LAST UPDATE: 2009.08.31
* VERSION: 1.0
*--------------------------------------------------------------------------------*
* DESCRIPTION:
*--------------------------------------------------------------------------------*
* CHANGE HISTORY
*--------------------------------------------------------------------------------*
* Changed by xxxxxxxx
* On xxxxxxxx
* Description of the changes:
* #1.
* #2.
* #...
*-----------------------------------------------------------------------------
REPORT ZMIGMM054 NO STANDARD PAGE HEADING
MESSAGE-ID ZMMA
LINE-SIZE 120
LINE-COUNT 55.

DATA:
GD_DOCUMENTHEADER LIKE BAPIACHE09,
GD_CUSTOMERCPD LIKE BAPIACPA09,
GD_FICA_HD LIKE BAPIACCAHD,
IT_ACCOUNTRECEIVABLE LIKE TABLE OF BAPIACAR09 WITH HEADER LINE,
IT_ACCOUNTGL LIKE TABLE OF BAPIACGL09 WITH HEADER LINE,
IT_ACCOUNTTAX LIKE TABLE OF BAPIACTX09 WITH HEADER LINE,
IT_CRITERIA LIKE TABLE OF BAPIACKEC9 WITH HEADER LINE,
IT_VALUEFIELD LIKE TABLE OF BAPIACKEV9 WITH HEADER LINE,
IT_CURRENCYAMOUNT LIKE TABLE OF BAPIACCR09 WITH HEADER LINE,
IT_RETURN LIKE TABLE OF BAPIRET2 WITH HEADER LINE,
IT_RECEIVERS LIKE TABLE OF BDI_LOGSYS WITH HEADER LINE,
IT_FICA_IT LIKE TABLE OF BAPIACCAIT WITH HEADER LINE,
IT_ACCOUNTPAYABLE LIKE TABLE OF BAPIACAP09 WITH HEADER LINE,
IT_PAYMENTCARD LIKE TABLE OF BAPIACPC09 WITH HEADER LINE,
IT_EXT LIKE TABLE OF BAPIACEXTC WITH HEADER LINE,
IT_RE LIKE TABLE OF BAPIACRE09 WITH HEADER LINE,
IT_EXT2 LIKE TABLE OF BAPIPAREX WITH HEADER LINE.

TABLES:SKB1,CSKS.

DATA: BEGIN OF GT_SOURCE OCCURS 0,
ITEMNO_ACC LIKE IT_ACCOUNTGL-ITEMNO_ACC, "行项目
GL_ACCOUNT LIKE IT_ACCOUNTGL-GL_ACCOUNT, "科目
COSTCENTER LIKE IT_ACCOUNTGL-COSTCENTER, "成本中心
ORDERID LIKE IT_ACCOUNTGL-ORDERID, "内部订单
ITEM_TEXT LIKE IT_ACCOUNTGL-ITEM_TEXT, "描述
RECNO(8) TYPE N, "记录数据在文件中的位置，防止排序不稳定的情况
"使生成的PO行项目的顺序与其在数据文件中的顺序一致
END OF GT_SOURCE.

DATA: BEGIN OF GT_ITAB OCCURS 0,
ITEMNO_ACC LIKE IT_CURRENCYAMOUNT-ITEMNO_ACC, "行项目
CURRENCY LIKE IT_CURRENCYAMOUNT-CURRENCY, "币别
AMT_DOCCUR(16) TYPE C, "LIKE IT_CURRENCYAMOUNT-AMT_DOCCUR, "金额
RECNO(8) TYPE N, "记录数据在文件中的位置，防止排序不稳定的情况
"使生成的PO行项目的顺序与其在数据文件中的顺序一致
END OF GT_ITAB.

DATA: G_FLAG_CHECK_RESULT TYPE C.

DATA: BEGIN OF GT_MESSAGE OCCURS 0.
INCLUDE STRUCTURE BAPIRET2.
DATA: LINE_COLOR(4) TYPE C,
END OF GT_MESSAGE.
TYPE-POOLS: SLIS. "ALV
*---------------------------------------------------------------------------------
* Data parameters for alv report use
*---------------------------------------------------------------------------------
DATA: GW_ALV_FIELDCAT_WA TYPE SLIS_FIELDCAT_ALV. "Fieldcat workarea
DATA: G_ALV_REPID LIKE SY-REPID,
G_ALV_STRUCTURE_NAME LIKE DD02L-TABNAME,
G_ALV_GRID_TITLE TYPE LVC_TITLE,
GW_ALV_LAYOUT TYPE SLIS_LAYOUT_ALV,
GT_ALV_FIELDCAT TYPE SLIS_T_FIELDCAT_ALV WITH HEADER LINE,
GT_ALV_SORT TYPE SLIS_T_SORTINFO_ALV WITH HEADER LINE,
GT_ALV_EVENTS TYPE SLIS_T_EVENT WITH HEADER LINE,
GT_ALV_LIST_HEADER TYPE SLIS_T_LISTHEADER WITH HEADER LINE.
*=================================================================================
* SELECTION-SCREEN
*=================================================================================
SELECTION-SCREEN BEGIN OF BLOCK BL01.
PARAMETERS:
CHECK RADIOBUTTON GROUP RB1 DEFAULT 'X',
POST RADIOBUTTON GROUP RB1.
SELECTION-SCREEN ULINE.
PARAMETERS: P_FNAME LIKE RLGRAP-FILENAME OBLIGATORY.
PARAMETERS: Q_FNAME LIKE RLGRAP-FILENAME OBLIGATORY.
SELECTION-SCREEN END OF BLOCK BL01 .

AT SELECTION-SCREEN ON VALUE-REQUEST FOR P_FNAME.
CALL FUNCTION 'WS_FILENAME_GET'
EXPORTING
DEF_PATH = 'C:'
* mask = ',Excel Files,*.xls;All Files,*.*.'
MASK = ',Text Files,*.txt;*.prn,All Files,*.*.'
TITLE = 'Select File'
IMPORTING
FILENAME = P_FNAME
EXCEPTIONS
INV_WINSYS = 1
NO_BATCH = 2
SELECTION_CANCEL = 3
SELECTION_ERROR = 4
OTHERS = 5.
IF SY-SUBRC NE 0 AND SY-SUBRC NE 3 AND P_FNAME NE SPACE.
MESSAGE ID SY-MSGID
TYPE SY-MSGTY
NUMBER SY-MSGNO
WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
ENDIF.

AT SELECTION-SCREEN ON VALUE-REQUEST FOR Q_FNAME.
CALL FUNCTION 'WS_FILENAME_GET'
EXPORTING
DEF_PATH = 'C:'
* mask = ',Excel Files,*.xls;All Files,*.*.'
MASK = ',Text Files,*.txt;*.prn,All Files,*.*.'
TITLE = 'Select File'
IMPORTING
FILENAME = Q_FNAME
EXCEPTIONS
INV_WINSYS = 1
NO_BATCH = 2
SELECTION_CANCEL = 3
SELECTION_ERROR = 4
OTHERS = 5.

IF SY-SUBRC NE 0 AND SY-SUBRC NE 3 AND P_FNAME NE SPACE.
MESSAGE ID SY-MSGID
TYPE SY-MSGTY
NUMBER SY-MSGNO
WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
ENDIF.

*---------------------------------------------------------------------------------
* START-OF-SELECTION
*---------------------------------------------------------------------------------
START-OF-SELECTION.
IF P_FNAME IS NOT INITIAL AND Q_FNAME IS NOT INITIAL.
PERFORM FILL_HEADER.
PERFORM FRM_UPLOAD_DATA.
PERFORM FRM_CHECK_DATA CHANGING G_FLAG_CHECK_RESULT.

PERFORM FILL_ACCOUNTGL.
PERFORM FILL_CURRENCY.
IF CHECK = 'X'.
PERFORM CHECK.
ENDIF.
IF POST = 'X'.
PERFORM POST.
ENDIF.
ENDIF.
*&---------------------------------------------------------------------*
*& Form FILL_CURRENCY
*&---------------------------------------------------------------------*
FORM CHECK.
CALL FUNCTION 'BAPI_ACC_DOCUMENT_CHECK'
EXPORTING
DOCUMENTHEADER = GD_DOCUMENTHEADER
CUSTOMERCPD = GD_CUSTOMERCPD
CONTRACTHEADER = GD_FICA_HD
TABLES
ACCOUNTGL = IT_ACCOUNTGL
ACCOUNTRECEIVABLE = IT_ACCOUNTRECEIVABLE
ACCOUNTTAX = IT_ACCOUNTTAX
CRITERIA = IT_CRITERIA
VALUEFIELD = IT_VALUEFIELD
EXTENSION1 = IT_EXT
RETURN = IT_RETURN
PAYMENTCARD = IT_PAYMENTCARD
CONTRACTITEM = IT_FICA_IT
EXTENSION2 = IT_EXT2
REALESTATE = IT_RE.
WRITE: / 'Result of check lines:'.

IF IT_RETURN[] IS INITIAL.
WRITE: / 'no messages'.
ELSE.
SKIP 1.
LOOP AT IT_RETURN.
WRITE: / IT_RETURN-TYPE,
(2) IT_RETURN-ID,
IT_RETURN-NUMBER,
(80) IT_RETURN-MESSAGE,
(20) IT_RETURN-PARAMETER,
(3) IT_RETURN-ROW,
IT_RETURN-FIELD.
ENDLOOP.
ENDIF.
ULINE.
ENDFORM. " FILL_CURRENCY
*&---------------------------------------------------------------------*
*& Form FILL_CURRENCY
*&---------------------------------------------------------------------*
FORM POST.
DATA: L_TYPE LIKE GD_DOCUMENTHEADER-OBJ_TYPE,
L_KEY LIKE GD_DOCUMENTHEADER-OBJ_KEY,
L_SYS LIKE GD_DOCUMENTHEADER-OBJ_SYS.
CALL FUNCTION 'BAPI_ACC_DOCUMENT_POST'
EXPORTING
DOCUMENTHEADER = GD_DOCUMENTHEADER
IMPORTING
OBJ_TYPE = L_TYPE
OBJ_KEY = L_KEY
OBJ_SYS = L_SYS
TABLES
ACCOUNTGL = IT_ACCOUNTGL
CURRENCYAMOUNT = IT_CURRENCYAMOUNT
RETURN = IT_RETURN.
WRITE: / 'Result of post:'. "#EC NOTEXT

IF IT_RETURN[] IS INITIAL.
WRITE: / 'no messages'.
ELSE.
SKIP 1.
LOOP AT IT_RETURN.
WRITE: / IT_RETURN-TYPE,
(2) IT_RETURN-ID,
IT_RETURN-NUMBER,
(80) IT_RETURN-MESSAGE,
(20) IT_RETURN-PARAMETER,
(3) IT_RETURN-ROW,
IT_RETURN-FIELD.
ENDLOOP.
ENDIF.
ULINE.
COMMIT WORK.
ENDFORM. " FILL_CURRENCY
*&---------------------------------------------------------------------*
*& Form frm_upload_data
*&---------------------------------------------------------------------*
FORM FRM_UPLOAD_DATA.
DATA: L_FNAME_STRING TYPE STRING.

L_FNAME_STRING = P_FNAME.

CALL FUNCTION 'GUI_UPLOAD'
EXPORTING
FILENAME = L_FNAME_STRING
FILETYPE = 'ASC'
HAS_FIELD_SEPARATOR = 'X'
TABLES
DATA_TAB = GT_SOURCE
EXCEPTIONS
FILE_OPEN_ERROR = 1
FILE_READ_ERROR = 2
NO_BATCH = 3
GUI_REFUSE_FILETRANSFER = 4
INVALID_TYPE = 5
NO_AUTHORITY = 6
UNKNOWN_ERROR = 7
BAD_DATA_FORMAT = 8
HEADER_NOT_ALLOWED = 9
SEPARATOR_NOT_ALLOWED = 10
HEADER_TOO_LONG = 11
UNKNOWN_DP_ERROR = 12
ACCESS_DENIED = 13
DP_OUT_OF_MEMORY = 14
DISK_FULL = 15
DP_TIMEOUT = 16
OTHERS = 17.

IF SY-SUBRC NE 0.
MESSAGE ID SY-MSGID TYPE 'S' NUMBER SY-MSGNO WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
STOP.
ELSE.
LOOP AT GT_SOURCE.
GT_SOURCE-RECNO = SY-TABIX.
MODIFY GT_SOURCE.
ENDLOOP.
ENDIF.

L_FNAME_STRING = Q_FNAME.

CALL FUNCTION 'GUI_UPLOAD'
EXPORTING
FILENAME = L_FNAME_STRING
FILETYPE = 'ASC'
HAS_FIELD_SEPARATOR = 'X'
TABLES
DATA_TAB = GT_ITAB
EXCEPTIONS
FILE_OPEN_ERROR = 1
FILE_READ_ERROR = 2
NO_BATCH = 3
GUI_REFUSE_FILETRANSFER = 4
INVALID_TYPE = 5
NO_AUTHORITY = 6
UNKNOWN_ERROR = 7
BAD_DATA_FORMAT = 8
HEADER_NOT_ALLOWED = 9
SEPARATOR_NOT_ALLOWED = 10
HEADER_TOO_LONG = 11
UNKNOWN_DP_ERROR = 12
ACCESS_DENIED = 13
DP_OUT_OF_MEMORY = 14
DISK_FULL = 15
DP_TIMEOUT = 16
OTHERS = 17.

IF SY-SUBRC NE 0.
MESSAGE ID SY-MSGID TYPE 'S' NUMBER SY-MSGNO WITH SY-MSGV1 SY-MSGV2 SY-MSGV3 SY-MSGV4.
STOP.
ELSE.
LOOP AT GT_ITAB.
GT_ITAB-RECNO = SY-TABIX.
MODIFY GT_ITAB.
ENDLOOP.
ENDIF.
ENDFORM. " frm_upload_data
*&---------------------------------------------------------------------*
*& Form frm_check_data
*&---------------------------------------------------------------------*
FORM FRM_CHECK_DATA CHANGING P_FLAG_CHECK_RESULT.
DATA: L_NUMBER_CHECK TYPE C,
L_MESSAGE_TEXT LIKE BAPIRET2-MESSAGE,
L_INDEX LIKE SY-TABIX.

CLEAR P_FLAG_CHECK_RESULT.

SORT GT_SOURCE BY ITEMNO_ACC.

DELETE GT_SOURCE WHERE ITEMNO_ACC = '' AND GL_ACCOUNT = ''.

LOOP AT GT_SOURCE.
L_INDEX = SY-TABIX.

TRANSLATE GT_SOURCE-ITEMNO_ACC TO UPPER CASE.
TRANSLATE GT_SOURCE-GL_ACCOUNT TO UPPER CASE.
TRANSLATE GT_SOURCE-COSTCENTER TO UPPER CASE.
TRANSLATE GT_SOURCE-ORDERID TO UPPER CASE.
TRANSLATE GT_SOURCE-ITEM_TEXT TO UPPER CASE.

* 科目内外转换/校验
CALL FUNCTION 'CONVERSION_EXIT_ALPHA_INPUT'
EXPORTING
INPUT = GT_SOURCE-GL_ACCOUNT
IMPORTING
OUTPUT = GT_SOURCE-GL_ACCOUNT
EXCEPTIONS
OTHERS = 1.

SELECT SINGLE * FROM SKB1 WHERE SAKNR = GT_SOURCE-GL_ACCOUNT AND BUKRS = '1000'.
IF SY-SUBRC NE 0.
CLEAR GT_MESSAGE.
MESSAGE E008 WITH GT_SOURCE-ITEMNO_ACC
GT_SOURCE-GL_ACCOUNT INTO L_MESSAGE_TEXT.
GT_MESSAGE-NUMBER = '009'.
GT_MESSAGE-MESSAGE = L_MESSAGE_TEXT.
APPEND GT_MESSAGE.

P_FLAG_CHECK_RESULT = 'E'.
ENDIF.

* 成本中心编码内外转换/校验
IF GT_SOURCE-COSTCENTER <> ''.
CALL FUNCTION 'CONVERSION_EXIT_ALPHA_INPUT'
EXPORTING
INPUT = GT_SOURCE-COSTCENTER
IMPORTING
OUTPUT = GT_SOURCE-COSTCENTER
EXCEPTIONS
OTHERS = 1.

SELECT SINGLE * FROM CSKS WHERE KOSTL = GT_SOURCE-COSTCENTER AND KOKRS = 'M100'.
IF SY-SUBRC NE 0.
CLEAR GT_MESSAGE.
MESSAGE E011 WITH GT_SOURCE-ITEMNO_ACC
GT_SOURCE-COSTCENTER INTO L_MESSAGE_TEXT.
GT_MESSAGE-NUMBER = '011'.
GT_MESSAGE-MESSAGE = L_MESSAGE_TEXT.
APPEND GT_MESSAGE.

P_FLAG_CHECK_RESULT = 'E'.
ENDIF.
ENDIF.

IF GT_SOURCE-ORDERID <> ''.
CALL FUNCTION 'CONVERSION_EXIT_ALPHA_INPUT'
EXPORTING
INPUT = GT_SOURCE-ORDERID
IMPORTING
OUTPUT = GT_SOURCE-ORDERID
EXCEPTIONS
OTHERS = 1.
ENDIF.

MODIFY GT_SOURCE INDEX L_INDEX.
ENDLOOP.

CLEAR P_FLAG_CHECK_RESULT.

SORT GT_ITAB BY ITEMNO_ACC.

LOOP AT GT_ITAB.
L_INDEX = SY-TABIX.

TRANSLATE GT_ITAB-ITEMNO_ACC TO UPPER CASE.
* TRANSLATE GT_ITAB-CURRENCY TO UPPER CASE.
* TRANSLATE GT_ITAB-AMT_DOCCUR TO UPPER CASE.

* 检查金额
PERFORM FRM_DEC_CHECK USING GT_ITAB-AMT_DOCCUR
CHANGING L_NUMBER_CHECK.
IF L_NUMBER_CHECK = 'N'.
CLEAR GT_MESSAGE.
MESSAGE E015 WITH GT_ITAB-ITEMNO_ACC
GT_ITAB-AMT_DOCCUR INTO L_MESSAGE_TEXT.
GT_MESSAGE-NUMBER = '015'.
GT_MESSAGE-MESSAGE = L_MESSAGE_TEXT.
APPEND GT_MESSAGE.

P_FLAG_CHECK_RESULT = 'E'.
ENDIF.
ENDLOOP.
ENDFORM. " frm_check_data
*---------------------------------------------------------------------*
* FORM fill_accountgl *
*---------------------------------------------------------------------*
FORM FILL_ACCOUNTGL.
LOOP AT GT_SOURCE.
IT_ACCOUNTGL-ITEMNO_ACC = GT_SOURCE-ITEMNO_ACC.
IT_ACCOUNTGL-GL_ACCOUNT = GT_SOURCE-GL_ACCOUNT.
IT_ACCOUNTGL-COSTCENTER = GT_SOURCE-COSTCENTER.
IT_ACCOUNTGL-ORDERID = GT_SOURCE-ORDERID.
IT_ACCOUNTGL-ITEM_TEXT = '调整'. "#EC NOTEXT
APPEND IT_ACCOUNTGL.
CLEAR IT_ACCOUNTGL.
ENDLOOP.
ENDFORM. "fill_accountgl
*---------------------------------------------------------------------*
* FORM fill_header *
*---------------------------------------------------------------------*
FORM FILL_HEADER.
GD_DOCUMENTHEADER-USERNAME = SY-UNAME.
GD_DOCUMENTHEADER-HEADER_TXT = '内部订单中心费用调整'. "#EC NOTEXT
GD_DOCUMENTHEADER-COMP_CODE = '1000'.
GD_DOCUMENTHEADER-DOC_DATE = SY-DATUM.
GD_DOCUMENTHEADER-PSTNG_DATE = '20081231'.
GD_DOCUMENTHEADER-FIS_PERIOD = '12'.
GD_DOCUMENTHEADER-DOC_TYPE = 'SA'.
GD_DOCUMENTHEADER-BUS_ACT = 'RFBU'.
ENDFORM. "fill_header
*&---------------------------------------------------------------------*
*& Form frm_dec_check
*&---------------------------------------------------------------------*
* 功能说明：判断是否为数字（含小数，不含符号）
* 约定：不判断符号，含+ - 的认为是非法的
*----------------------------------------------------------------------*
* 以下四种格式认为是合法的：
* '*' '.*' '*.' '*.*'
* 其中*代表至少一个0-9的数字
*----------------------------------------------------------------------*
FORM FRM_DEC_CHECK USING P_CHECK_STRING TYPE C
CHANGING P_CHECK_RESULT TYPE C.

DATA: L_CHAR TYPE C,
L_DOTNUM TYPE I,
L_LEN TYPE I,
L_POSITION TYPE I.

CONSTANTS: C_STANDARD(12) TYPE C VALUE '0123456789. ',
C_DIGITAL(10) TYPE C VALUE '0123456789'.

DATA: L_CHECK_STRING TYPE STRING.

P_CHECK_RESULT = 'Y'.
L_CHECK_STRING = P_CHECK_STRING.
L_DOTNUM = 0.

CONDENSE L_CHECK_STRING. "删除左空格--去除字符串中的前导空格(左边空格)，并用一个空格替换其它空格序列

L_LEN = STRLEN( L_CHECK_STRING ). "有效长度---含左边空格，不含右边空格的字符长度

IF L_LEN = 0. "为空
* p_check_result = 'N'.
EXIT.
ENDIF.

IF L_CHECK_STRING CN C_STANDARD. "过滤：仅含数字、小数点、空格
P_CHECK_RESULT = 'N'. "约定：不判断符号，含+ - 的认为是非法的
EXIT.
ENDIF.

* 有效长度非0，有效长度内已只含数字、小数点、空格，且无左空格
IF L_LEN = 1 AND L_CHECK_STRING+0(1) NA C_DIGITAL. "过滤：只有一个小数点
P_CHECK_RESULT = 'N'.
EXIT.
ENDIF.

L_POSITION = 0.
WHILE L_POSITION < L_LEN.
L_CHAR = L_CHECK_STRING+L_POSITION(1).
IF L_CHAR EQ '.'.
L_DOTNUM = L_DOTNUM + 1.
ELSEIF L_CHAR NA C_DIGITAL. "排除有效长度内含空格的
P_CHECK_RESULT = 'N'.
EXIT.
ENDIF.
L_POSITION = L_POSITION + 1.
ENDWHILE.

IF L_DOTNUM > 1. "排除有效长度内含多个小数点的
P_CHECK_RESULT = 'N'.
ENDIF.
ENDFORM. "frm_dec_check
*&---------------------------------------------------------------------*
*& Form FILL_CURRENCY
*&---------------------------------------------------------------------*
FORM FILL_CURRENCY.
LOOP AT GT_ITAB.
IT_CURRENCYAMOUNT-ITEMNO_ACC = GT_ITAB-ITEMNO_ACC.
IT_CURRENCYAMOUNT-CURRENCY = GT_ITAB-CURRENCY.
IT_CURRENCYAMOUNT-AMT_DOCCUR = GT_ITAB-AMT_DOCCUR.
APPEND IT_CURRENCYAMOUNT.
CLEAR IT_CURRENCYAMOUNT.
ENDLOOP.
ENDFORM. " FILL_CURRENCY

来自 “ ITPUB博客 ” ，链接：http://blog.itpub.net/195776/viewspace-1026815/，如需转载，请注明出处，否则将追究法律责任。

转载于:http://blog.itpub.net/195776/viewspace-1026815/