EMail senden aus MEDRUCK

Code: Alles auswählen.

*&---------------------------------------------------------------------*
*& Program  ZMEDRUCK_EMAIL
*&
*&---------------------------------------------------------------------*
*&
*&
*&---------------------------------------------------------------------*

PROGRAM zmedruck_email_bds2.

PARAMETERS p_email TYPE text80 LOWER CASE.
PARAMETERS p_sender TYPE text80 LOWER CASE.
PARAMETERS p_norep AS CHECKBOX.

SELECTION-SCREEN SKIP 1.
SELECTION-SCREEN ULINE.
PARAMETERS p_spool TYPE itcpp-tdspoolid."Spool number for tesing
PARAMETERS g_debug AS CHECKBOX.         "Sapscript Debugger active

PERFORM test.
EXIT.

* WARNING : NO POPUPS - NO COMMIT WORK IN HERE !!!!!!!!!!!!!!!!!!!!!!!!!


* How to do (i left some TODO-comments)
* 1.) Change/verify the "PERFORM" so the "TRUE" Print Routine is called
*     (only needed if you have an own ME_DRUCK) just look table TNAPR
* 2.) Change the Receiver Email-adress.
* 3.) Activate ZMEDRUCK_EMAIL :-)
* 4.) Customize (Tc NACE) the message-Type "NEU" and enter
*     "ZMEDRUCK_EMAIL" as Program and "ENTRY_NEU" as FORM

* How it is working (short version)
* by customizing, the original Print routine is substituted by this one
* to retrieve the SpoolId, which we need for PDF generation and email.
* ZMEDRUCK_EMAIL_BDS calls the "Original" Print routine as a subroutine.
* After this step the Program retrieves the Spool created.
* Then the OTF is converted into PDF and attached to the mail


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

*&---------------------------------------------------------------------*
*&      Form  ENTRY
*&---------------------------------------------------------------------*
*       text
*----------------------------------------------------------------------*
*      -->RETURN_CODE  text
*      -->US_SCREEN    text
*----------------------------------------------------------------------*
FORM entry_neu 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
************************
* @@@@ TODO !!!!!
************************ /SMB40/FM06P
*-orig program---------+
*                      |
*-orig Form---+        |
*             |        |
  CASE nast-kschl.
    WHEN 'NEU'.
      PERFORM entry_neu(/SMB40/FM06P) USING return_code us_screen.
    WHEN 'YNEU'.
      PERFORM entry_neu(sapfm06p) USING return_code us_screen.
    WHEN OTHERS.
  ENDCASE.

  PERFORM read_variant.

* use Test case in Preview mode and if SAPscript debugger is active
  IF NOT us_screen IS INITIAL AND NOT g_debug IS INITIAL.

    spoolid = p_spool.

    PERFORM processing USING spoolid.
    EXIT.
  ENDIF.

* 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
*----------------------------------------------------------------------*
FORM processing USING spoolid TYPE itcpp-tdspoolid.

  DATA l_upd TYPE sy-subrc.
  DATA l_spnr TYPE rspoid.
  DATA lsmtp_addr TYPE  ad_smtpadr .
  DATA lsubject TYPE so_obj_des.
  DATA l_sender TYPE ad_smtpadr VALUE 'Sender@xy.sap'.
  DATA l_use_noreply TYPE xfeld VALUE 'X'.

  DATA l_ebeln TYPE ekpa-ebeln.
  DATA l_lifnr TYPE lfa1-lifnr.
  DATA l_adrnr TYPE lfa1-adrnr.

  DATA tt_soli TYPE bcsy_text.
  DATA s_soli TYPE soli.
*----------------------------------------------------------------------*
* read vendor email
*----------------------------------------------------------------------*
  CALL FUNCTION 'CONVERSION_EXIT_ALPHA_INPUT'
    EXPORTING
      input  = nast-parnr
    IMPORTING
      output = l_lifnr.

  SELECT SINGLE adrnr FROM lfa1 INTO l_adrnr WHERE
    lifnr = l_lifnr.
  IF NOT l_adrnr IS INITIAL.
    SELECT SINGLE smtp_addr FROM adr6 INTO lsmtp_addr WHERE
      addrnumber = l_adrnr AND flgdefault = 'X'.
  ENDIF.

* no email found - exit
  IF lsmtp_addr IS INITIAL.
    lsmtp_addr = p_email. "use Fallback receiver email
  ENDIF.

  IF NOT g_debug IS INITIAL.
    lsmtp_addr = p_email. "use Fallback receiver email
  ENDIF.

  IF lsmtp_addr IS INITIAL.
    EXIT."no receiver email
  ENDIF.

*----------------------------------------------------------------------*
* create Email subject
*----------------------------------------------------------------------*
  lsubject = 'Purchase Order'.
  IF nast-spras = 'D'.
    lsubject = 'Bestellung'.
  ENDIF.

  IF NOT g_debug IS INITIAL.
    CONCATENATE 'TEST:' lsubject INTO lsubject SEPARATED BY space..
  ENDIF.

  CONCATENATE lsubject nast-objky INTO lsubject SEPARATED BY space.

*----------------------------------------------------------------------*
* create Email body
*----------------------------------------------------------------------*
  DATA s_tk TYPE stxh_key.
  DATA t_text TYPE TABLE OF tline.
  DATA s_text TYPE tline.

  s_tk-tdobject = 'EKKO'.
  s_tk-tdid = 'F21'.
  s_tk-tdspras = nast-spras.
  s_tk-tdname = nast-objky.

  CALL FUNCTION 'READ_TEXT'
    EXPORTING
      id                      = s_tk-tdid
      language                = s_tk-tdspras
      name                    = s_tk-tdname
      object                  = s_tk-tdobject
    TABLES
      lines                   = t_text
    EXCEPTIONS
      id                      = 1
      language                = 2
      name                    = 3
      not_found               = 4
      object                  = 5
      reference_check         = 6
      wrong_access_to_archive = 7
      OTHERS                  = 8.
  IF sy-subrc <> 0.
  ELSE.
    LOOP AT t_text INTO s_text.
      s_soli = s_text-tdline.
      APPEND s_soli TO tt_soli.
    ENDLOOP.
  ENDIF.

  l_spnr = spoolid.

  l_sender = p_sender." Sender Email address


*----------------------------------------------------------------------*
* Post Email
*----------------------------------------------------------------------*
* Verbucher aktiv ?
  CALL FUNCTION 'TH_IN_UPDATE_TASK'
    IMPORTING
      in_update_task = l_upd.

  IF l_upd IS INITIAL.
    CALL FUNCTION 'Y_BC_EMAIL_POST'
      EXPORTING
        i_rqident     = l_spnr
        i_smtp_addr   = lsmtp_addr
        i_sender      = l_sender
        tt_text       = tt_soli
        i_subject     = lsubject
        i_use_noreply = p_norep.

    COMMIT WORK AND WAIT.

  ELSE.

    CALL FUNCTION 'Y_BC_EMAIL_POST' IN UPDATE TASK
      EXPORTING
        i_rqident     = l_spnr
        i_smtp_addr   = lsmtp_addr
        i_sender      = l_sender
        tt_text       = tt_soli
        i_subject     = lsubject
        i_use_noreply = p_norep.

  ENDIF.

ENDFORM.                    "processing
*----------------------------------------------------------------------*
* Read Variant DEFAULT with initialization parameters
*----------------------------------------------------------------------*

FORM read_variant.
  TYPES: BEGIN OF ty_info,
           typ(1),
           null(1),
           line(120),
         END OF ty_info.

* für autom. Variante TEST laden
  DATA:
    l_report   TYPE raldb_repo ##NEEDED,
    l_variante TYPE raldb_vari ##NEEDED,
    t_info     TYPE TABLE OF ty_info ##NEEDED.

** Load variant sy-uname
  l_report   = sy-repid.
  l_variante = 'DEFAULT'.


  CALL FUNCTION 'RS_COVERPAGE_SELECTIONS'
    EXPORTING
      report  = l_report
      variant = l_variante
    TABLES
      infotab = t_info
    EXCEPTIONS
      OTHERS  = 3 ##FM_SUBRC_OK.
ENDFORM.


FORM test.
  DATA rc TYPE i.

  SELECT SINGLE * FROM nast INTO nast WHERE objky = '4512043568' .
  nast-vstat = '0'.

  SELECT SINGLE * FROM tnapr INTO tnapr WHERE
    kschl = 'NEU' AND
    nacha = '1' AND
    kappl = 'EF'.

  PERFORM entry_neu USING rc ' '.

ENDFORM.

Code: Alles auswählen.

FUNCTION Y_bc_email_post.
*"----------------------------------------------------------------------
*"*"Update Function Module:
*"
*"*"Local Interface:
*"  IMPORTING
*"     VALUE(I_RQIDENT) TYPE  RSPOID
*"     VALUE(I_SMTP_ADDR) TYPE  AD_SMTPADR
*"     VALUE(I_SENDER) TYPE  AD_SMTPADR OPTIONAL
*"     VALUE(TT_TEXT) TYPE  BCSY_TEXT OPTIONAL
*"     VALUE(I_SUBJECT) TYPE  SO_OBJ_DES
*"     VALUE(I_FILENAME) TYPE  SO_OBJ_DES OPTIONAL
*"     VALUE(I_USE_NOREPLY) TYPE  XFELD OPTIONAL
*"----------------------------------------------------------------------

  DATA lv_len TYPE i.
  DATA pdf_xstring TYPE xstring.
*     -------- convert document -------------------------------
  DATA pdf_content TYPE TABLE OF solix.
* for email contents
  DATA lv_internetadr TYPE adr6-smtp_addr.
  DATA lv_attname TYPE sood-objdes.

  DATA  send_request       TYPE REF TO cl_bcs.
  DATA  ls_soli            TYPE soli.
  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.
  DATA  sender             TYPE REF TO if_sender_bcs.
  DATA  l_sendadr          TYPE adr6-smtp_addr.

  CALL FUNCTION 'CONVERT_OTFSPOOLJOB_2_PDF'
    EXPORTING
      src_spoolid              = i_rqident
      no_dialog                = 'X'
*     DST_DEVICE               =
      pdf_destination          = 'X'
*     NO_BACKGROUND            =
*     USE_CASCADING            = ' '
    IMPORTING
      pdf_bytecount            = lv_len
*     PDF_SPOOLID              =
*     OTF_PAGECOUNT            =
*     BTC_JOBNAME              =
*     BTC_JOBCOUNT             =
      bin_file                 = pdf_xstring
* TABLES
*     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
      OTHERS                   = 12.

  IF sy-subrc <> 0.
  ENDIF.


  pdf_content = cl_document_bcs=>xstring_to_solix( pdf_xstring ).

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

*     email subject
      document = cl_document_bcs=>create_document(
                                i_type    = 'RAW'
                                i_text    = tt_text
                                i_subject = i_subject ).

*     add list attachment to document
      IF i_filename IS INITIAL.
        CONCATENATE i_subject '.pdf' INTO lv_attname.
      ELSE.
        CONCATENATE i_filename '.pdf' INTO lv_attname.
      ENDIF.
      document->add_attachment( i_attachment_type    = 'PDF'
                                i_attachment_subject = lv_attname
                                i_att_content_hex    = pdf_content ).

*=============== prep send

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

*     create recipient and add to send request

      recipient = cl_cam_address_bcs=>create_internet_address( i_smtp_addr ).

      send_request->add_recipient( i_recipient = recipient ).

*    create sender and add to send request
      IF NOT i_use_noreply IS INITIAL.
        CONCATENATE 'Noreply@' sy-sysid '-' sy-mandt '.de' INTO l_sendadr.
        sender = cl_cam_address_bcs=>create_internet_address( l_sendadr ).
        send_request->set_sender( EXPORTING i_sender = sender ).
      ELSE.
        IF NOT i_sender IS INITIAL.
          l_sendadr = i_sender.
          sender = cl_cam_address_bcs=>create_internet_address( l_sendadr ).
          send_request->set_sender( EXPORTING i_sender = sender ).
        ENDIF.
      ENDIF.

*     send
      send_request->set_send_immediately( i_send_immediately = 'X' ).
      sent_to_all = send_request->send( i_with_error_screen = 'X' ).

    CATCH cx_bcs INTO bcs_exception.
      MESSAGE s865(so) WITH bcs_exception->error_type DISPLAY LIKE 'E'.
  ENDTRY.

*    commit work and wait.

ENDFUNCTION.