User-Exit bei VF01 bzw. VF02

Code: Alles auswählen.

*    *&---------------------------------------------------------------------*
*    *& Subroutinepool INVOICE EMAIL AS PDF ATTACHMENT                      *
*    *&                                                                     *
*    *&---------------------------------------------------------------------*
*    *&                                                                     *
*    *&                                                                     *
*    *&---------------------------------------------------------------------*
*
*    * WARNING : NO POPUPS - NO COMMIT WORK ALLOWED !!!!!!!!!!!!!!!!!!!!!!!!!

     REPORT  mail.
     DATA: retcode   LIKE sy-subrc.         "Returncode
     DATA: xscreen(1) TYPE c.               "Output on printer or screen
     TABLES: nast,
             knvk,
             vbrk,
             kna1,                      "Messages
             tnapr.                         "Programs & Forms

*    *&---------------------------------------------------------------------*
*    *&      Form  ENTRY
*    *&---------------------------------------------------------------------*
*    *       text
*    *----------------------------------------------------------------------*
*    *      -->RETURN_CODE  text
*    *      -->US_SCREEN    text
*    *----------------------------------------------------------------------*
     FORM entry USING return_code TYPE i
                      us_screen TYPE c.

       FIELD-SYMBOLS: <f> TYPE itcpp,
                      <p> TYPE  ssfcrescl.

       DATA pgnam TYPE na_pgnam." Programname
       DATA ronam TYPE na_ronam."Formname
       DATA fm_name TYPE rs38l_fnam. "genr.Druckbaustein
       DATA lv_vec(80).
       DATA spoolid TYPE rspoid.

       CLEAR retcode.
       xscreen = us_screen.

*    *   Call the "Original" Printroutine

*    * RVADIN01 = Sapscript
*    * RLB_INVOICE = Smartforms

*    *-Orig program------+
*    *                   |
*    *-Orig Form-+       |
*    *           |       |
       PERFORM entry(rlb_invoice) USING return_code us_screen.

*    * Try Sapscript
       ASSIGN ('(SAPLSTXC)ITCPP') TO <f>.
       IF sy-subrc = 0 AND
          NOT <f>-tdspoolid IS INITIAL AND
          us_screen IS INITIAL.

         PERFORM processing USING <f>-tdspoolid.
         UNASSIGN <f>.

       ELSE.
*    * Try Smartforms
         CALL FUNCTION 'SSF_FUNCTION_MODULE_NAME'
           EXPORTING
             formname           = tnapr-sform
           IMPORTING
             fm_name            = fm_name
           EXCEPTIONS
             no_form            = 1
             no_function_module = 2
             OTHERS             = 3.

         IF sy-subrc <> 0.
           retcode = 1.
           EXIT.
         ENDIF.

         SELECT SINGLE pname FROM tfdir INTO lv_vec
         WHERE funcname = fm_name.
         IF sy-subrc = 0.

           CONCATENATE '(' lv_vec ')JOB_OUTPUT_INFO' INTO lv_vec.
           ASSIGN (lv_vec) TO <p>.

           IF sy-subrc = 0 AND
           NOT <p>-spoolids[] IS INITIAL AND
           us_screen IS INITIAL.

             LOOP AT <p>-spoolids INTO spoolid.
               PERFORM processing USING spoolid.
               EXIT.
             ENDLOOP.
             UNASSIGN <p>.

           ENDIF. " have Ids

         ENDIF." tfdir entry

       ENDIF." sapscript/smartforms


       IF retcode NE 0.
         return_code = 1.
       ELSE.
         return_code = 0.
       ENDIF.

     ENDFORM.                    "ENTRY

*    *&---------------------------------------------------------------------*
*    *&      Form  processing
*    *&---------------------------------------------------------------------*
*    *       text
*    *----------------------------------------------------------------------*
*    *      -->SPOOLID    text
*    *----------------------------------------------------------------------*
     FORM processing USING spoolid TYPE itcpp-tdspoolid.

       DATA numbytes TYPE i.
       DATA lbuffer TYPE xstring.


       DATA: BEGIN OF lt_pdf OCCURS 0,
             t(134),
             END OF lt_pdf.

       DATA object_txt LIKE solisti1 OCCURS 10 WITH HEADER LINE.


*    * for Invoice Header Text
       DATA:
       lv_hd TYPE thead,
       lv_id TYPE thead-tdid,
       lv_language TYPE thead-tdspras,
       lv_name TYPE thead-tdname,
       lv_object TYPE thead-tdobject,
       lt_lines TYPE TABLE OF tline,
       ls_line TYPE tline.

*    * For partner Email
       CONSTANTS:
       lv_item_number TYPE vbup-posnr VALUE '000000',
       lv_partner_role TYPE vbpa-parvw VALUE 'RE'.

       DATA:
       lv_document_number TYPE vbuk-vbeln,
       vborg TYPE vbrk-vkorg,
       ls_vbpa TYPE vbpa.
*       ls_vbpa TYPE vbpk,

       DATA  ls_part TYPE kna1-name1.



*    * For Email contents
       DATA contents_hex TYPE solix_tab.
       DATA lv_internetadr TYPE adr6-smtp_addr.
       DATA lv_internetadra TYPE knvv-z_sd_mail_adress.
       DATA lv_subject TYPE so_obj_des.
       DATA lv_attname TYPE sood-objdes.

       DATA  send_request       TYPE REF TO cl_bcs.
       DATA  text               TYPE bcsy_text.
       DATA  document           TYPE REF TO cl_document_bcs.
       DATA  recipient          TYPE REF TO if_recipient_bcs.
       DATA  bcs_exception      TYPE REF TO cx_bcs.
       DATA  sent_to_all        TYPE os_boolean.


       CLEAR numbytes.

       CALL FUNCTION 'CONVERT_OTFSPOOLJOB_2_PDF'
         EXPORTING
           src_spoolid              = spoolid
           no_dialog                = ' '
*          DST_DEVICE               =
*          PDF_DESTINATION          =
         IMPORTING
           pdf_bytecount            = numbytes
*          pdf_spoolid              = pdfspoolid
*          OTF_PAGECOUNT            =
*          btc_jobname              = jobname
*          btc_jobcount             = jobcount
         TABLES
           pdf                      = lt_pdf
         EXCEPTIONS
           err_no_otf_spooljob      = 1
           err_no_spooljob          = 2
           err_no_permission        = 3
           err_conv_not_possible    = 4
           err_bad_dstdevice        = 5
           user_cancelled           = 6
           err_spoolerror           = 7
           err_temseerror           = 8
           err_btcjob_open_failed   = 9
           err_btcjob_submit_failed = 10
           err_btcjob_close_failed  = 11.

       IF sy-subrc = 0.

         CALL FUNCTION 'SCMS_BINARY_TO_XSTRING'
           EXPORTING
             input_length = numbytes
           IMPORTING
             buffer       = lbuffer
           TABLES
             binary_tab   = lt_pdf
           EXCEPTIONS
             failed       = 1
             OTHERS       = 2.

         IF sy-subrc <> 0.
         ENDIF.


         CALL FUNCTION 'SCMS_XSTRING_TO_BINARY'
           EXPORTING
             buffer     = lbuffer
           TABLES
             binary_tab = contents_hex[].
       ENDIF.

       TRY.
*    *     create the send request
           send_request = cl_bcs=>create_persistent( ).

           lv_language = nast-spras.
           lv_name = nast-objky.

           CALL FUNCTION 'READ_TEXT'
             EXPORTING
               id                      = 'YMEL'
               language                = 'lv_language'
               name                    = 'EMAIL'
               object                  = 'TEXT'
             IMPORTING
               header                  = lv_hd
             TABLES
               lines                   = lt_lines
             EXCEPTIONS
               id                      = 1
               language                = 2
               name                    = 3
               not_found               = 4
               object                  = 5
               reference_check         = 6
               wrong_access_to_archive = 7
               OTHERS                  = 8.


           CALL FUNCTION 'TEXT_SYMBOL_SETVALUE'
             EXPORTING
               name  = '&INNUM&'
               value = nast-objky.

           CALL FUNCTION 'TEXT_SYMBOL_SETVALUE'
             EXPORTING
               name  = '&USER&'
               value = nast-usnam.


           CALL FUNCTION 'TEXT_SYMBOL_REPLACE'
             EXPORTING
               header           = lv_hd
               replace_program  = 'X'
               replace_standard = 'X'
               replace_system   = 'X'
               replace_text     = 'X'
             TABLES
               lines            = lt_lines.


           IF sy-subrc <> 0.
           ENDIF.

           LOOP AT lt_lines INTO ls_line.
             APPEND ls_line-tdline TO text.
           ENDLOOP.

           lv_document_number = nast-objky.


*    * Get Partner RE Email
           CALL FUNCTION 'SD_VBPA_SELECT'
             EXPORTING
               i_document_number = lv_document_number
               i_item_number     = lv_item_number
               i_partner_role    = lv_partner_role
             IMPORTING
               e_vbpa            = ls_vbpa
             EXCEPTIONS
               partner_not_found = 1
               OTHERS            = 2.

           IF sy-subrc <> 0.
           ENDIF.

*           CLEAR lv_internetadr.
*           SELECT SINGLE smtp_addr FROM adr6 INTO lv_internetadr WHERE
*           addrnumber = ls_vbpa-kunnr AND flgdefault = 'X'.


           DATA: ls_vkorg TYPE vbrk-vkorg,
                 ls_vtweg TYPE vbrk-vtweg,
                 ls_spart TYPE vbrk-spart.

           SELECT SINGLE vkorg FROM vbrk INTO ls_vkorg WHERE
              vbeln = nast-objky.

           SELECT SINGLE vtweg  FROM vbrk INTO ls_vtweg WHERE
              vbeln = nast-objky.

           SELECT SINGLE spart FROM vbrk INTO ls_spart WHERE
               vbeln = nast-objky.

           CLEAR lv_internetadr.
           SELECT SINGLE mail FROM knvv INTO lv_internetadr
             WHERE kunnr = ls_vbpa-kunnr
             AND vkorg = ls_vkorg
             AND vtweg = ls_vtweg
             AND spart = ls_spart
             AND z_sd_mail_flag = 'X'.



*    * Email subject

           IF nast-spras = 'D'.

             CONCATENATE 'Rechnung: ' nast-objky INTO lv_subject.

           ELSE.

             CONCATENATE 'Invoice: ' nast-objky INTO lv_subject.


           ENDIF.


           document = cl_document_bcs=>create_document(
                                     i_type    = 'RAW'
                                     i_text    = text
                                     i_subject = lv_subject ).

*    *     add list attachment to document

           IF nast-spras = 'D'.

             CONCATENATE 'Rechnung:' nast-objky '.pdf' INTO lv_attname.

           ELSE.

             CONCATENATE 'Invoice' nast-objky '.pdf' INTO lv_attname.

           ENDIF.

           document->add_attachment( i_attachment_type    = 'PDF'
                                     i_attachment_subject = lv_attname
                                     i_att_content_hex    = contents_hex ).



*    *     add document to send request
           send_request->set_document( document ).

*    *     create recipient and add to send request

*           recipient = cl_sapuser_bcs=>create( sy-uname ).

           IF lv_internetadr IS INITIAL.
             recipient = cl_sapuser_bcs=>create( sy-uname ).
           ELSE.
             recipient = cl_cam_address_bcs=>create_internet_address( lv_internetadr ).
           ENDIF.

           send_request->add_recipient( i_recipient = recipient ).


*    *     send
           send_request->set_send_immediately( i_send_immediately = 'X' ).
           sent_to_all = send_request->send( i_with_error_screen = 'X' ).
           IF sent_to_all = 'X'.
             MESSAGE s022(so).
           ENDIF.

         CATCH cx_bcs INTO bcs_exception.
           MESSAGE e865(so) WITH bcs_exception->error_type.
       ENDTRY.

       CLEAR:
         document,
         recipient,
        send_request.


     ENDFORM.                    "processing