ABAP 发送带EXCEL邮件

前言

没啥特殊需求，就是有个库龄报表用户想整邮件发送

实现

用的最简单的XLS文件作为excel附件发送出去
观察XLS文件的纯文本格式，每列之间用TAB制表符分隔，每行之间用回车符分隔

思路也比较明确，在SAP中实现这种格式，再转二进制流就好了
下面的代码替换掉lt_data就可以直接使用，用的动态内表自动将内表转成纯文本

*&---------------------------------------------------------------------*
*& Form frm_2023122702
*&---------------------------------------------------------------------*
*& text
*&---------------------------------------------------------------------*
*& -->  p1        text
*& <--  p2        text
*&---------------------------------------------------------------------*
FORM frm_2023122702 .

  TYPES: BEGIN OF ty_mrtab,
           matnr TYPE mara-matnr,
           maktx TYPE makt-maktx,
           mtart TYPE mara-mtart,
         END OF ty_mrtab.
  FIELD-SYMBOLS: <gt_table> TYPE table.         "DYNAMIC TABLE INDICATE
  " 容器字段
  FIELD-SYMBOLS: <fs_data>      TYPE any,
                 <fs_cell_data> TYPE any.
  DATA: lr_data            TYPE REF TO data,
        lo_descr           TYPE REF TO cl_abap_typedescr,
        lo_str_descr_in    TYPE REF TO cl_abap_structdescr,
        ls_abap_comp_descr TYPE abap_compdescr.

  "附件参数
  DATA: lt_otf    TYPE TABLE OF itcoo,
        lt_tline  TYPE TABLE OF tline,
        lt_record TYPE TABLE OF solisti1,
        ls_otf    TYPE itcoo,
        ls_tline  TYPE tline,
        ls_record TYPE solisti1.
  "邮件参数
  DATA: lv_size      TYPE i, "邮件附件大小
        lv_lines_txt TYPE i, "邮件文本行数
        lv_lines_bin TYPE i, "邮件附件行数
        lv_benfile   TYPE xstring,
        lv_object    TYPE char50, "邮件主题
        lv_filename  TYPE char50,
        lt_objpack   TYPE TABLE OF sopcklsti1 , "邮件内容 正文+附件
        lt_objtxt    TYPE TABLE OF solisti1   , "正文内容
        lt_objbin    TYPE TABLE OF solisti1   , "附件内容
        lt_reclist   TYPE TABLE OF somlreci1  , "收件人
        ls_doc_chng  TYPE sodocchgi1, "邮件属性
        ls_objpack   TYPE sopcklsti1,
        ls_objtxt    TYPE solisti1,
        ls_objbin    TYPE solisti1,
        ls_reclist   TYPE somlreci1.

  DATA: lv_str  TYPE string,
        lv_cell TYPE string.

* 需要转excel的内表
  DATA: lt_data TYPE TABLE OF ty_mrtab.
  lt_data = VALUE #( ( matnr = '100' maktx = '硅粉621，纯度≥99.1%，P＜80ppm；B＜50ppm' mtart = '1000' )
                     ( matnr = '200' maktx = '硅粉621，纯度≥99.1%，P＜80ppm；B＜50ppm' mtart = '1000' ) ).

  " 转动态内表以符合各种场景
  ASSIGN lt_data TO <gt_table>.

*&--获取lt_data的表结构
  CREATE DATA lr_data LIKE LINE OF <gt_table>.
  ASSIGN lr_data->* TO <fs_data>.

  " EXCEL表头
*  LOOP AT gt_fieldcat_alv INTO DATA(ls_fieldcat_alv).
*    " 单元格 + TAB符
*    lv_str = lv_str && ls_fieldcat_alv-seltext_l && cl_abap_char_utilities=>horizontal_tab.
*  ENDLOOP.
*  " 最后使用回车符换行
*  lv_str = lv_str && cl_abap_char_utilities=>cr_lf.

*&--获取内表列字段
  CALL METHOD cl_abap_structdescr=>describe_by_data
    EXPORTING
      p_data      = <fs_data>
    RECEIVING
      p_descr_ref = lo_descr.

  lo_str_descr_in ?= lo_descr.

*&--EXCEL表体
  LOOP AT <gt_table> ASSIGNING <fs_data>.
*    CLEAR: lv_str,lv_start,lv_end.

    " 循环每行的每个单元格
    LOOP AT lo_str_descr_in->components INTO ls_abap_comp_descr.

      " 根据字段名找到字段
      ASSIGN COMPONENT ls_abap_comp_descr-name OF STRUCTURE <fs_data> TO <fs_cell_data>.

      " 去除首尾引号，否则xls文件中tab符会有问题
      lv_cell = <fs_cell_data>.
      REPLACE ALL OCCURRENCES OF REGEX '^"*|"*$' IN lv_cell WITH ''.

      " 单元格 + TAB符
      lv_str = lv_str && lv_cell && cl_abap_char_utilities=>horizontal_tab.

    ENDLOOP.

    " 最后使用回车符换行
    lv_str = lv_str && cl_abap_char_utilities=>cr_lf.

  ENDLOOP.

  "string类型-> XSTRING
  CALL FUNCTION 'SCMS_STRING_TO_XSTRING'
    EXPORTING
      text     = lv_str
*     mimetype = 'XLS'
      encoding = '8404' "防止中文乱码
    IMPORTING
      buffer   = lv_benfile
    EXCEPTIONS
      failed   = 1
      OTHERS   = 2.

  IF lv_benfile IS NOT INITIAL.
    CALL FUNCTION 'SCMS_XSTRING_TO_BINARY'
      EXPORTING
        buffer        = lv_benfile
      IMPORTING
        output_length = lv_size
      TABLES
        binary_tab    = lt_record.
  ENDIF.

  "将转换后的文件添加到邮件附件
  APPEND LINES OF lt_record TO lt_objbin.

*  &---邮件处理

  " 获取收件人
  SELECT DISTINCT
    smtp_addr
  FROM zmmt045
  INTO TABLE @DATA(lt_receiver).
  lv_size = lines( lt_objbin ) * 255.

  "添加邮件正文
  ls_objtxt = 'ZMMR011报表已导出，请查看附件'. "
  APPEND ls_objtxt TO lt_objtxt.

  "邮件正文行数
  lv_lines_txt = lines( lt_objtxt ).
  lv_object = 'ZMMR011导出'. " 标题：ZMMR011报表
  lv_filename = 'ZMMR011.XLS'.  " 附件XLS命名
  ls_doc_chng-obj_langu = sy-langu.
  ls_doc_chng-obj_name = 'Email'.  " Email
*        ls_doc_chng-expiry_dat = sy-datum + 10.  " 邮件过期日，在此日期后邮件将无法被查看
  ls_doc_chng-obj_descr = lv_object.  "邮件标题
*        ls_doc_chng-sensitivty = 'F'.  " 邮件保密等级
  ls_doc_chng-doc_size = lv_lines_txt * 255 + lv_size.
  ls_doc_chng-priority = '3'. " 1：低优先级 3：普通优先级 5：高优先级

  CLEAR ls_objpack-transf_bin.
  ls_objpack-head_start = 1.
  ls_objpack-head_num = 0.
  ls_objpack-body_start = 1.
  ls_objpack-body_num = lv_lines_txt.
  ls_objpack-doc_type = 'RAW'.
  APPEND ls_objpack TO lt_objpack.

  CLEAR:lv_lines_bin.
  ls_objpack-transf_bin = 'X'.
  ls_objpack-head_start = 1.
  ls_objpack-head_num = 1.
  ls_objpack-body_start = 1.

  lv_lines_bin = lines( lt_objbin ).

  ls_objpack-doc_size = lv_size .
  ls_objpack-body_num = lv_lines_bin.
  ls_objpack-doc_type = 'XLS'.
  ls_objpack-obj_descr = lv_filename.
  APPEND ls_objpack TO lt_objpack.

  lt_reclist = VALUE #( FOR lw_receiver IN lt_receiver
                        ( receiver = lw_receiver  " 收件人邮箱
                          rec_type = 'U' ) ).

  CALL FUNCTION 'SO_NEW_DOCUMENT_ATT_SEND_API1'
    EXPORTING
      document_data              = ls_doc_chng  " 邮件属性
      put_in_outbox              = ''
      commit_work                = 'X'
    TABLES
      packing_list               = lt_objpack  " 邮件内容
      contents_bin               = lt_objbin   " 附件内容（二进制）
      contents_txt               = lt_objtxt   " 邮件内容（直接填入）
      receivers                  = lt_reclist  " 收件箱地址
    EXCEPTIONS
      too_many_receivers         = 1
      document_not_sent          = 2
      document_type_not_exist    = 3
      operation_no_authorization = 4
      parameter_error            = 5
      x_error                    = 6
      enqueue_error              = 7
      OTHERS                     = 8.

  IF sy-subrc = 0.
*    es_return-type = 'S'.
*    es_return-message = es_return-message && TEXT-m19. " 邮件发送成功
    WAIT UP TO 1 SECONDS.
    " 立即发送邮件
    SUBMIT rsconn01                                      "#EC CI_SUBMIT
    WITH mode = 'INT' WITH output = '' AND RETURN. ".
  ELSE.
*    es_return-type = 'S'.
*    es_return-message = es_return-message && TEXT-m20. " 邮件发送失败
  ENDIF.

ENDFORM.