ABAP Muestra en alv el contenido de una carpeta

report zpruebasf .
*-Variable para pasarle la ruta a la función
parameter p_file type localfile.
DATA: lv_name TYPE salfile-longname.
data it_filedir type filedir occurs 0 with header line.
data: begin of i_out occurs 0,
check(1),
line(255),
procesado(9).
data end of i_out.
data g_repid like sy-repid.
include zalv." el include para alv tambien esta en este blog
*->Levanto la lista de directorios


start-of-selection.
g_repid = sy-repid.

lv_name = p_file.
CALL FUNCTION 'RZL_READ_DIR_LOCAL'
EXPORTING
name = lv_name
TABLES
file_tbl = it_filedir
EXCEPTIONS
argument_error = 1
not_found = 2
OTHERS = 3.
IF sy-subrc <> 0.
MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
ENDIF.

loop at it_filedir.
move it_filedir to i_out-line.
append i_out.
endloop.

PERFORM obt_descrip_campos_tabla USING g_repid 'I_OUT'.
layout-box_fieldname = 'CHECK'.
layout-box_tabname = 'I_OUT'.

PERFORM carac_gen_listado.
PERFORM visualizar_lista TABLES I_OUT USING 'I_OUT'
g_repid .

Programa genera demanda

************************************************************************
*Programa que crea la demanda de materianles por medio de la MD61
*leyendo un archivo desde el servidor
************************************************************************


REPORT ZDEMANDA .


************************************************************************
* *VARIABLES
************************************************************************
data A(10).
data porc type i.
data archivo type localfile.
data tamano(10).
data g_repid like sy-repid.
data: lv_name TYPE salfile-longname.
data it_filedir type filedir occurs 0 with header line.
include zalv.
data OPENG(1).
data CSYSUBRC like Sy-subrc.

************************************************************************
* *TABLAS INTERNAS
************************************************************************
data i_zdemanda like zdemanda occurs 0 with header line.
*Tabla interna para alv
data: begin of i_out occurs 0,
check(1),
line(255).
data end of i_out.
*Tabla interna para cargar cada archivo
DATA: BEGIN OF i_table OCCURS 0,
l_line(1000) type c.
DATA: END OF i_table.
*Tabla interna para separar cada linea de el archivo
DATA: BEGIN OF i_split OCCURS 0,
line(1000) type c.
DATA: END OF i_split.
*Tablas para hacer el batch input
DATA: BDC_TAB LIKE STANDARD TABLE OF BDCDATA WITH HEADER LINE,
ERR_BI LIKE STANDARD TABLE OF BDCMSGCOLL WITH HEADER LINE.

************************************************************************
* *PARAMETROS DE SELECCION
************************************************************************
SELECTION-SCREEN BEGIN OF BLOCK block1 WITH FRAME title text-001.
PARAMETERS:
p_file TYPE rlgrap-filename OBLIGATORY DEFAULT
'C:\Inetpub\ftproot\operaciones\mrp\',
Mode(1) default 'N',
SESSION(1) default 'X',
p_separa(1) default ',',
pro as checkbox.

SELECTION-SCREEN END OF BLOCK block1.




************************************************************************
* *START-OF-SELECTION
************************************************************************
************************************************************************
START-OF-SELECTION.
g_repid = sy-repid.
lv_name = p_file.
*Traemos el contenido del directorio
CALL FUNCTION 'RZL_READ_DIR_LOCAL'
EXPORTING
name = lv_name
TABLES
file_tbl = it_filedir
EXCEPTIONS
argument_error = 1
not_found = 2
OTHERS = 3.
IF sy-subrc <> 0.
MESSAGE ID sy-msgid TYPE sy-msgty NUMBER sy-msgno
WITH sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
ENDIF.
*Eliminamos las que sean directorios o de tamaño = 0
loop at it_filedir.
i_out-line = it_filedir.
if not i_out-line cs '0000000000' and i_out-line cs 'PRON'.
append i_out.
endif.
endloop.

*Eliminamos de la lista los que ya fueron procesados
if pro <> 'X'.
loop at i_out.
split i_out-line at space into archivo tamano.
condense archivo.
select * from zdemanda into table i_zdemanda
where nombre = archivo.
if sy-subrc = 0.
delete i_out.
endif.
endloop.
endif.

*Lanzamos un alv con el listado y un campo check
clear i_zdemanda.
refresh i_zdemanda.
PERFORM obt_descrip_campos_tabla USING g_repid 'I_OUT'.
layout-box_fieldname = 'CHECK'.
layout-box_tabname = 'I_OUT'.
PERFORM camb_descrip_campos_tabla USING 'LINE'
'Archivo'.

PERFORM carac_gen_listado.
PERFORM visualizar_lista TABLES I_OUT USING 'I_OUT'
g_repid .


*&---------------------------------------------------------------------*
*& Form F_CARGA_FICHERO
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_I_TABLE text
* -->P_P_FILE text
*----------------------------------------------------------------------*
FORM F_CARGA_FICHERO TABLES i_table STRUCTURE i_table
USING P_P_FILE.

data: v_files type string.

v_files = p_p_file.

refresh i_table.

open dataset v_files for input in text mode.
if sy-subrc is initial.
do.
read dataset v_files into i_table.
if not sy-subrc is initial.
exit.
endif.
append i_table.
enddo.
endif.
close dataset v_files.

if sy-subrc ne 0.
write: /'No se Pudo cargar el archivo ', archivo .
else.
write: /'Se ha cargado el archivo ',archivo,' correctamente'.
endif.

ENDFORM. " F_CARGA_FICHERO


*&---------------------------------------------------------------------*
*& Form f_batch_MD61
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_batch_MD61.
Data: material(20),
centro(4),
periodo(1),
cantidad(10),
MENSAJE LIKE T100-TEXT,
COPY_SYTABIX LIKE SY-TABIX,
contador like sy-tabix value 0,
fecha like SCAL-WEEK,
fecha1 LIKE SCAL-DATE,
fecha2 like SCAL-DATE,
texto(100),
texto2(100),
si(1).

clear: contador, copy_sytabix,si,centro,periodo,material.

LOOP AT I_SPLIT.
contador = contador + 1.
move sy-tabix to COPY_SYTABIX.
if si is initial and contador > 3.
si = 'X'.
else.
si = ''.
endif.
if COPY_SYTABIX = 1.
centro = i_split-line.
endif.
if COPY_SYTABIX = 2.
periodo = i_split-line.
endif.
if COPY_SYTABIX = 3.
material = i_split-line.
endif.

IF COPY_SYTABIX > 3 AND SI = 'X'.
REFRESH BDC_TAB.
perform bdc_dynpro using 'SAPMM60X' '0100'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'AM60X-MATAW'
'X'.
perform bdc_field using 'AM60X-MATNR'
material.
perform bdc_field using 'AM60X-WERKS'
centro.
perform bdc_field using 'RM60X-VERSB'
'00'.
perform bdc_field using 'RM60X-ENTLU'
periodo.

*Obtenemos las fechas de acuerdo a la semana que indique el archivo

read table i_split index contador.
texto = i_split-line.
concatenate texto+3(4) texto+0(2) into texto.
move texto to fecha.
CALL FUNCTION 'WEEK_GET_FIRST_DAY'
EXPORTING
WEEK = fecha
IMPORTING
DATE = fecha1
EXCEPTIONS
WEEK_INVALID = 1
OTHERS = 2.
IF SY-SUBRC <> 0.
fecha1 = fecha.
fecha2 = fecha.
SY-SUBRC = 0.
endif.

IF SY-SUBRC = 0.
fecha2 = fecha1 + 6.
concatenate fecha1+6(2) fecha1+4(2) fecha1+0(4) into fecha1.
concatenate fecha2+6(2) fecha2+4(2) fecha2+0(4) into fecha2.
perform bdc_field using 'RM60X-DATVE'
fecha1.
perform bdc_field using 'RM60X-DATBE'
fecha2.
perform bdc_dynpro using 'SAPLM60E' '0200'.
perform bdc_field using 'BDC_OKCODE'
'=PEIN'.
perform bdc_dynpro using 'SAPLM60E' '0200'.
perform bdc_field using 'BDC_OKCODE'
'/00'.
perform bdc_field using 'BDC_CURSOR'
'RM60E-PLNMG(01)'.
perform bdc_field using 'PBPT-VERVS'
'X'.
perform bdc_field using 'RM60E-EDATU(01)'
i_split-line.
contador = contador + 1.
read table i_split index contador.
perform bdc_field using 'RM60E-PLNMG(01)'
i_split-line.
move i_split-line to cantidad.
contador = contador - 1.
perform bdc_dynpro using 'SAPLM60E' '0200'.
perform bdc_field using 'BDC_OKCODE'
'=SICH'.
REFRESH ERR_BI.

CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
PERCENTAGE = porc
TEXT = A.

CALL TRANSACTION 'MD61' USING BDC_TAB MODE MODE MESSAGES INTO ERR_BI.
CSYSUBRC = SY-SUBRC.
commit work.
condense: material,texto.


IF CSYSUBRC = 0.

concatenate
'Centro:' centro
'**Material:'material
'**Semana:' texto
'**Cantidad:' cantidad
'**sin errores' into texto.
translate texto using '* '.
WRITE:/ texto color col_positive.
ELSE.

* Adición de la transacción errónea al JD para procesarlo on-line
if OPENG is initial.
perform open_group.
OPENG = 'X'.
endif.

PERFORM BDC_INSERT.
concatenate
'Centro:' centro
'**Material:' material
'**Semana:' texto
'**Con errores' into texto.
translate texto using '* '.
WRITE: / texto color col_negative.
LOOP AT ERR_BI.
SELECT SINGLE TEXT INTO MENSAJE
FROM T100
WHERE SPRSL = 'S' AND
ARBGB = ERR_BI-MSGID AND
MSGNR = ERR_BI-MSGNR.
NEW-LINE.
WRITE AT: 1 ERR_BI-DYNAME,
15 ERR_BI-DYNUMB,
20 ERR_BI-MSGTYP,
22 ERR_BI-MSGNR,
26 MENSAJE.
ENDLOOP.
ENDIF.
ENDIF."fecha
ENDIF.">3
ENDLOOP."I_SPLIT
ENDFORM. " f_batch_MD61


*----------------------------------------------------------------------*
* create batchinput session *
* Creamos una sesion de batch para los errores *
*----------------------------------------------------------------------*

FORM OPEN_GROUP.
IF SESSION = 'X'.
CALL FUNCTION 'BDC_OPEN_GROUP'
EXPORTING
CLIENT = SY-MANDT
GROUP = 'ZDEMANDA'
KEEP = 'X'
USER = SY-UNAME.
ENDIF.
ENDFORM.

*----------------------------------------------------------------------*
* create batchinput session *
* Cerramos una sesion de batch para los errores *
*----------------------------------------------------------------------*
IF SESSION = 'X'.

CALL FUNCTION 'BDC_CLOSE_GROUP'
EXCEPTIONS
NOT_OPEN = 1
QUEUE_ERROR = 2
OTHERS = 3.
ENDIF.

*----------------------------------------------------------------------*
* Start new screen *
*----------------------------------------------------------------------*
FORM BDC_DYNPRO USING PROGRAM DYNPRO.
CLEAR BDC_TAB.
BDC_TAB-PROGRAM = PROGRAM.
BDC_TAB-DYNPRO = DYNPRO.
BDC_TAB-DYNBEGIN = 'X'.
APPEND BDC_TAB.
ENDFORM.

*----------------------------------------------------------------------*
* Insert field *
*----------------------------------------------------------------------*
FORM BDC_FIELD USING FNAM FVAL.
IF SESSION = 'X'.
CLEAR BDC_TAB.
BDC_TAB-FNAM = FNAM.
BDC_TAB-FVAL = FVAL.
APPEND BDC_TAB.
ENDIF.
ENDFORM.
*&---------------------------------------------------------------------*
*& Form BDC_INSERT
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM BDC_INSERT.
CALL FUNCTION 'BDC_INSERT'
EXPORTING
TCODE = 'MD61'
TABLES
DYNPROTAB = BDC_TAB.
ENDFORM. " BDC_INSERT
*&---------------------------------------------------------------------*
*& Form close_group
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM close_group.
CALL FUNCTION 'BDC_CLOSE_GROUP'
EXCEPTIONS
NOT_OPEN = 1
QUEUE_ERROR = 2
OTHERS = 3.

ENDFORM. " close_group

*---------------------------------------------------------------------*
* FORM SET_STATUS *
*---------------------------------------------------------------------*

form set_status using rt_extab type slis_t_extab.

set pf-status 'ZSTANDARD'. "Status nuevo
set titlebar 'T001'. "Titulo

endform.

*&---------------------------------------------------------------------*
*& Form USER_COMMAND
*&---------------------------------------------------------------------*

FORM USER_COMMAND USING r_ucomm LIKE sy-ucomm
rs_selfield TYPE slis_selfield.

data: archivos type i, lineas type i.
data carchivos(5).
*CUANDO SE PRESIONE EL BOTON PROCESAR ARCHIVO
CASE r_ucomm.
WHEN '&PRO'. "si presiona el boton procesar
*CONTAMOS CANTIDAD DE ARCHIVOS SELECCIONADOS
loop at i_out where check = 'X'.
archivos = archivos + 1.
endloop.
move archivos to carchivos.
archivos = 0.
loop at i_out where check = 'X'.
archivos = archivos + 1.
move archivos to A.
condense: A, carchivos.
concatenate A '/' carchivos into A.
clear: archivo, tamano.
split i_out-line at space into archivo tamano.
i_zdemanda-fecha = sy-datum.
i_zdemanda-hora = sy-uzeit.
i_zdemanda-usuario = sy-uname.
i_zdemanda-nombre = archivo.
insert zdemanda from i_zdemanda.
concatenate p_file archivo into archivo.
perform f_carga_fichero tables i_table using archivo.
*Para cada linea del archivo cargado se hace una llamada a MD61
delete i_table where l_line = ''.
describe table i_table lines lineas.
loop at i_table.

split i_table at p_separa into table i_split.
perform f_batch_MD61.
skip.
porc = sy-tabix * ( 100 / lineas ).
CALL FUNCTION 'SAPGUI_PROGRESS_INDICATOR'
EXPORTING
PERCENTAGE = PORC
TEXT = A.

endloop.
if OPENG = 'X'.
perform close_group.
skip.
WRITE: 'Los errores se pueden tratar en SM35 "ZDEMANDA", o corrija el
archivo e intente de nuevo.'
color col_total.
endif.
endloop."i_out-check = 'X'.
ENDCASE.
clear i_out.
refresh i_out.
ENDFORM.

Traspasos

report ztraspasos line-size 185.
tables: lips, likp, disvariant, mara.
*VARIABLES PARA BATCH INPUT
data v_traspaso(20).
CONSTANTS:
CODE LIKE TSTC-TCODE VALUE 'MB1B'.
DATA: BDC_TAB LIKE STANDARD TABLE OF BDCDATA WITH HEADER LINE,
ERR_BI LIKE STANDARD TABLE OF BDCMSGCOLL WITH HEADER LINE.
*VARIABLES PARA GRABAR DISPOSICION
data: gx_variant like disvariant.
data: g_variant like disvariant.
data: g_variant_save value 'U'.
data: g_variant_flag.
data: estado(10).
*TABLA INTERNA PARA LOS DATOS
data begin of i_datos occurs 0 .
DATA: EXTRN like CFPAR-EXTRN,
VBELN like LIPS-VBELN,
ERDAT like LIPS-ERDAT,
kodat like likp-kodat,
POSNR like LIPS-POSNR,
MATNR like lips-matnr,
WERKS like lips-werks,
LGORT like lips-lgort,
LFIMG like lips-lfimg,
VRKME like lips-vrkme,
NTGEW like lips-ntgew,
BRGEW like lips-brgew,
ARKTX like lips-arktx.
data end of i_datos.

*TABLA INTERNA DE LOTES
data begin of i_mchb occurs 0.

data:
VBELN like LIPS-VBELN,
POSNR like LIPS-POSNR,
MATNR like mchb-matnr,
WERKS like mchb-werks,
Lgort like mchb-lgort,
charg like mchb-charg,
clabs like mchb-clabs,
MATNR2 like mchb-matnr,
WERKS2 like mchb-werks,
Lgort2 like mchb-lgort,
charg2 like mchb-charg,
clabs2 like mchb-clabs.

data end of i_mchb.

data begin of i_mchbtemp occurs 0.

data:
VBELN like LIPS-VBELN,
POSNR like LIPS-POSNR,
MATNR like mchb-matnr,
WERKS like mchb-werks,
Lgort like mchb-lgort,
charg like mchb-charg,
clabs like mchb-clabs,
MATNR2 like mchb-matnr,
WERKS2 like mchb-werks,
Lgort2 like mchb-lgort,
charg2 like mchb-charg,
clabs2 like mchb-clabs.

data end of i_mchbtemp.


data: begin of i_likp occurs 0,
vbeln like likp-vbeln,
kodat like likp-kodat.
data end of i_likp.
*PARA ALV
type-pools: slis.
data: gt_fieldcat type slis_t_fieldcat_alv with header line,
gs_layout type slis_layout_alv,
g_repid like sy-repid.

*PARAMETROS
selection-screen begin of block list with frame title text-001.

select-options:
p_vbeln for lips-vbeln,
p_kodat for likp-kodat obligatory,
p_erdat for lips-erdat,
p_werks for lips-werks obligatory default '0030',
p_lgort for lips-lgort obligatory default '0014',
p_matnr for lips-matnr.
parameter v_todosl as checkbox.
selection-screen end of block list.

selection-screen begin of block list2 with frame title text-002.
parameter p_varia like disvariant-variant default '/STD'.
parameter modo(1) default 'A'.

selection-screen end of block list2.

include zalv.
*PARA SELECCIONAR LA VISUALIZACION
at selection-screen output.

clear g_variant.
g_variant-report = sy-repid.
g_variant-username = sy-uname.

if p_varia is initial and
g_variant_flag is initial.
perform get_default_variant_f14 using p_varia.
g_variant_flag = 'X'.
endif.

at selection-screen on value-request for p_varia.
perform variant_inputhelp_f14 using p_varia.

at user-command.
break-point.
initialization.

g_repid = sy-repid.

start-of-selection.

perform trae_datos.
PERFORM obt_descrip_campos_tabla USING g_repid 'I_DATOS'.
layout-box_fieldname = 'EXTRN'.
layout-box_tabname = 'I_DATOS'.

PERFORM carac_gen_listado.
PERFORM visualizar_lista TABLES I_DATOS USING 'I_DATOS' g_repid .

*&---------------------------------------------------------------------*
*& Form TRAE_DATOS
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
form trae_datos.

select vbeln kodat from likp into table i_likp
where kodat in p_kodat
and erdat in p_erdat.

if sy-subrc ne 0.
message i368(00) with 'No hay información'.
exit.
endif.

select * from lips into corresponding fields of table i_datos
for all entries in i_likp
where vbeln eq i_likp-vbeln
and werks in p_werks
and lgort in p_lgort
and matnr in p_matnr.
"and posnr < 900000.

*PASAMOS EL CAMPO KODAT(fecha pick)
loop at i_datos.
read table i_likp with key vbeln = i_datos-vbeln.
if sy-subrc = 0.
i_datos-kodat = i_likp-kodat.
modify i_datos.
endif.
endloop.

endform. " TRAE_DATOS



*---------------------------------------------------------------------*
* FORM SET_STATUS *
*---------------------------------------------------------------------*

form set_status using rt_extab type slis_t_extab.

set pf-status 'ZSTANDARD'. "Status nuevo
set titlebar 'T001'. "Titulo

endform.

*PARA VISUALIZACION
*&---------------------------------------------------------------------*
*& Form variant_inputhelp_f14
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_p_varia text
*----------------------------------------------------------------------*
form variant_inputhelp_f14 using p_variant like g_variant-variant.

* Esta rutina funciona como un search help recuperando los layouts
* creados por el usuario

data h_exit.

clear gx_variant.

call function 'REUSE_ALV_VARIANT_F4'
exporting
is_variant = g_variant
i_save = g_variant_save
importing
e_exit = h_exit
es_variant = gx_variant
exceptions
not_found = 1
program_error = 2
others = 3.

if sy-subrc is initial and h_exit is initial.
g_variant-variant = gx_variant-variant.
p_variant = gx_variant-variant.
else.
message id sy-msgid type 'S'
number sy-msgno
with sy-msgv1 sy-msgv2 sy-msgv3 sy-msgv4.
endif.

endform. "variant_inputhelp_f14


*&---------------------------------------------------------------------*
*& Form get_default_variant_f14
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* -->P_VARIANT text
*----------------------------------------------------------------------*
form get_default_variant_f14 using p_variant like g_variant-variant.

* Recupera datos para luego poder recuperar los diferentes layouts....
gx_variant = g_variant.
clear gx_variant-variant.
clear gx_variant-text.

if not p_variant is initial.
gx_variant-variant = p_variant.
endif.

call function 'REUSE_ALV_VARIANT_DEFAULT_GET'
exporting
i_save = g_variant_save
changing
cs_variant = gx_variant
exceptions
wrong_input = 1
not_found = 2
program_error = 3
others = 4.

case sy-subrc.
when 0.
p_variant = gx_variant-variant.
when 2.
clear p_variant.
endcase.

endform. "get_default_variant_f14

*&---------------------------------------------------------------------*
*& Form USER_COMMAND
*&---------------------------------------------------------------------*

FORM USER_COMMAND USING r_ucomm LIKE sy-ucomm
rs_selfield TYPE slis_selfield.
*EN CASO DE TRASPASOS
data i_datos2 like i_datos occurs 0 with header line.
i_datos2[] = i_datos[].
CASE r_ucomm.
WHEN '%LOT'. "si presiona el boton lotes
"Loop a los que se hayan seleccionado
delete i_datos2 where extrn <> 'X'.
Loop at i_datos2 where EXTRN = 'X'.
"Bloqueamos las entregas
at new vbeln.
CALL FUNCTION 'ENQUEUE_EVVBLKE'
EXPORTING
MODE_LIKP = 'E'
MANDT = SY-MANDT
VBELN = i_datos2-vbeln
X_VBELN = ' '
_SCOPE = '2'
_WAIT = ' '
_COLLECT = ' '
EXCEPTIONS
FOREIGN_LOCK = 1
SYSTEM_FAILURE = 2
OTHERS = 3
.
IF SY-SUBRC <> 0.
message e386(00) with 'Error al bloquear Entrega' i_datos2-vbeln.
ENDIF.
endat.
endloop.

"una vez bloqueadas las entregas traemos los lotes de esas entregas
select matnr lgort werks charg clabs from mchb into corresponding
fields of
table i_mchb
for all entries in i_datos2 where
matnr = i_datos2-matnr
and lgort = i_datos2-lgort
and werks = i_datos2-werks
and not clabs = 0.

loop at i_mchb.
i_mchb-matnr2 = i_mchb-matnr.
i_mchb-werks2 = i_mchb-werks.
i_mchb-lgort2 = '0010'.
i_mchb-charg2 = i_mchb-charg.
i_mchb-clabs2 = i_mchb-clabs.
modify i_mchb.
endloop.

if sy-subrc = 0.
"una vez seleccionados los lotes dejamos solo la cantidad necesaria
"para cada entrega
"en caso que vengan materiales iguales.
" data i_mchbtemp like i_mchb occurs 0 with header line.
clear i_mchbtemp.
refresh i_mchbtemp.

loop at i_datos2.

loop at i_mchb where matnr = i_datos2-matnr.
i_mchb-vbeln = i_datos2-vbeln.
i_mchb-posnr = i_datos2-posnr.

if i_datos2-lfimg > i_mchb-clabs and i_datos2-lfimg <> 0.
i_datos2-lfimg = i_datos2-lfimg - i_mchb-clabs.
move-corresponding i_mchb to i_mchbtemp.
read table i_mchbtemp with key matnr = i_mchb-matnr
clabs = i_mchb-clabs charg = i_mchb-charg.
i_mchb-clabs = 0.
append i_mchbtemp.

modify i_mchb.
elseif i_datos2-lfimg = i_mchb-clabs and i_datos2-lfimg <> 0.
move-corresponding i_mchb to i_mchbtemp.
i_mchb-clabs = 0.
i_datos2-lfimg = 0.
read table i_mchbtemp with key matnr = i_mchb-matnr
clabs = i_mchb-clabs charg = i_mchb-charg.
append i_mchbtemp.
modify i_mchb.
"exit.
elseif i_datos2-lfimg < i_mchb-clabs and i_datos2-lfimg <> 0.
move-corresponding i_mchb to i_mchbtemp.
read table i_mchbtemp with key matnr = i_mchb-matnr
clabs = i_mchb-clabs charg = i_mchb-charg.

i_mchb-clabs = i_mchb-clabs - i_datos2-lfimg.
i_mchbtemp-clabs2 = i_datos2-lfimg.
i_datos2-lfimg = 0.
append i_mchbtemp.

modify i_mchb.
"exit.
endif.

if v_todosl = 'X'.
if i_mchb-clabs2 = i_mchb-clabs.
move-corresponding i_mchb to i_mchbtemp.
i_mchbtemp-clabs2 = 0.
append i_mchbtemp.
endif.
endif.

endloop.
endloop."i_datos2



"Mandamos el listado de los lotes para que lo modifique o lo acepte
PERFORM obt_descrip_campos_tabla USING g_repid 'I_MCHBTEMP'.
layout-box_fieldname = ''.
layout-box_tabname = ''.
PERFORM camb_descrip_campos_tabla USING 'CLABS2'
'transpasar'.

PERFORM asignar_edit_campo USING 'CLABS2' 'X'.
PERFORM carac_gen_listado.
estado = 'lotes'.
PERFORM visualizar_lista TABLES I_MCHBTEMP USING 'I_MCHBTEMP'
g_repid .

endif.
WHEN '&TRA'. "si presiona el boton traspasos
if estado is initial.
message e368(00) with 'Aun no ha seleccionado los lotes'.
else.
"comprobamos que no esten agarrando lotes de mas
data suma like i_mchbtemp-clabs.
loop at i_mchb.
suma = 0.
loop at i_mchbtemp where charg = i_mchb-charg.
suma = i_mchbtemp-clabs2 + suma.
if suma > i_mchb-clabs2.
message e138(00) with 'Error en lote' i_mchb-charg
' solo hay disponibles ' i_mchb-clabs.
endif.
endloop.
endloop.

"ya selecciono los lotes, de acuerdo a estos se manda llamar la
"un batch input a la MB1B con los traspasos que sean necesarios
PERFORM f_traspasa.
if v_traspaso = 'sin errores'.
PERFORM f_modificaentrega.
endif.
Clear i_MCHB.
refresh i_MCHB.
endif."estado initial.

ENDCASE.
ENDFORM.

*&---------------------------------------------------------------------*
*& Form f_traspasa

*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM f_traspasa.
DATA IMARA LIKE MARA OCCURS 0 WITH HEADER LINE.

Select matnr meins from MARA into corresponding fields of table IMARA
for all entries in I_MCHB
where MATNR = I_MCHB-MATNR.

DATA COPY_SYTABIX LIKE SY-TABIX.
loop at i_mchb.
i_mchb-clabs2 = i_mchb-clabs2 - i_mchb-clabs.
modify i_mchb.
if i_mchb-clabs2 = 0.
delete i_mchb.
endif.
endloop.

read table i_mchb index 1.
if sy-subrc = 0.

MOVE SY-TABIX TO COPY_SYTABIX.

* Apertura de un JD para las transacciones erróneas
*AT FIRST.
*PERFORM BDC_OPEN.
*ENDAT.

* Proceso de cada registro (cada registro es una transacción)
REFRESH BDC_TAB. "<------------------ Borrar la transacción anterior

perform DYNPRO using 'X' 'SAPMM07M' '0400'.
perform DYNPRO using '' 'BDC_CURSOR'
'MKPF-BUDAT'.
*perform DYNPRO using '' 'BDC_OKCODE'
* '=NPE'.
perform DYNPRO using '' 'RM07M-BWARTWA'
'311'.
perform DYNPRO using '' 'RM07M-WERKS'
i_mchb-werks.
perform DYNPRO using '' 'RM07M-LGORT'
i_mchb-lgort.
perform DYNPRO using '' 'XFULL'
'X'.
perform DYNPRO using '' 'RM07M-XNAPR'
'X'.
perform DYNPRO using '' 'RM07M-WVERS3'
'X'.
perform DYNPRO using '' 'BDC_OKCODE'
'=NPE'.
data i_mchblines like sy-tabix.
describe table i_mchb lines i_mchblines.
data xmeins(10).
LOOP AT I_MCHB.
read table imara with key matnr = i_mchb-matnr.
write imara-meins to xmeins.
perform DYNPRO using 'X' 'SAPMM07M' '0410'.
*perform DYNPRO using '' 'BDC_CURSOR'
* 'MSEG-UMLGO'.

perform DYNPRO using '' 'BDC_OKCODE'
'/00'.

perform DYNPRO using '' 'MSEG-MATNR'
i_mchb-matnr.
perform DYNPRO using '' 'MSEG-ERFMG'
i_mchb-clabs2 .
read table IMARA with key matnr = i_mchb-matnr.

perform DYNPRO using '' 'MSEG-ERFME'
xmeins.
perform DYNPRO using '' 'MSEG-WERKS'
i_mchb-werks.
perform DYNPRO using '' 'MSEG-LGORT'
i_mchb-lgort.
perform DYNPRO using '' 'MSEG-CHARG'
i_mchb-charg.
perform DYNPRO using '' 'MSEG-UMLGO'
i_mchb-lgort2.
perform DYNPRO using '' 'DKACB-FMORE'
'X'.
if i_mchblines <> 1.
i_mchblines = i_mchblines - 1.
perform DYNPRO using '' 'BDC_OKCODE'
'=NPE'.
endif.


perform DYNPRO using 'X' 'SAPLKACB' '0002'.
perform DYNPRO using '' 'BDC_OKCODE'
'=ENTE'.
ENDLOOP.

perform DYNPRO using 'X' 'SAPMM07M' '0410'.
perform DYNPRO using '' 'BDC_CURSOR'
'MSEG-ERFMG'.
perform DYNPRO using '' 'BDC_OKCODE'
'=BU'.
perform DYNPRO using 'X' 'SAPLKACB' '0002'.
perform DYNPRO using '' 'BDC_OKCODE'
'=ENTE'.

* Escribimos los mensajes de cada transacción para que salgan agrupa-
* dos con el mensaje de 'sin errores' o 'con errores' de su transacc.
* correspondiente. Para ello es necesario limpiar la tabla ERR_BI en
* cada transacción ya que el sistema no la limpia cuando llama a la
* transacción.
REFRESH ERR_BI.
CALL TRANSACTION 'MB1B' USING BDC_TAB MODE MODO MESSAGES INTO ERR_BI.
NEW-LINE.
IF SY-SUBRC = 0.
*WRITE:'Transacción', COPY_SYTABIX LEFT-JUSTIFIED, ': sin errores'.
v_traspaso = 'sin errores'.
ELSE.
v_traspaso = 'con errores'.
*WRITE:'Transacción', COPY_SYTABIX LEFT-JUSTIFIED, ': con errores'.
* Adición de la transacción errónea al JD para procesarlo on-line
* PERFORM BDC_INSERT.
ENDIF.

ENDIF."<--------------------------- I_MCHB tiene algo

ENDFORM. " CALLTRANSACTION

*&---------------------------------------------------------------------*
*& Form DYNPRO
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
FORM DYNPRO USING VALUE(DYNBEGIN)
VALUE(NAME)
VALUE(VALUE).

CLEAR BDC_TAB.
IF DYNBEGIN = 'X'.
BDC_TAB-PROGRAM = NAME.
BDC_TAB-DYNPRO = VALUE.
BDC_TAB-DYNBEGIN = 'X'.
ELSE.
BDC_TAB-FNAM = NAME.
BDC_TAB-FVAL = VALUE.
condense BDC_TAB-FVAL.
ENDIF.
APPEND BDC_TAB.
CLEAR BDC_TAB.

ENDFORM. " DYNPRO
*&---------------------------------------------------------------------*
*& Form f_modificaentrega
*&---------------------------------------------------------------------*
* text
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_modificaentrega.
*<data i_mchbtmp like i_mchb occurs 0 with header line.
i_mchbtmp[] = i_mchbtemp[].
delete adjacent duplicates from i_mchbtmp comparing vbeln posnr.
"modificamos las entregas
data suma like i_mchbtmp-clabs2.
loop at i_datos where EXTRN = 'X'.


CALL FUNCTION 'DEQUEUE_EVVBLKE'
EXPORTING
MODE_LIKP = 'E'
MANDT = SY-MANDT
VBELN = i_datos-vbeln
X_VBELN = ' '
_SCOPE = '2'
_WAIT = ' '
_COLLECT = ' '
EXCEPTIONS
FOREIGN_LOCK = 1
SYSTEM_FAILURE = 2
OTHERS = 3
.
IF SY-SUBRC <> 0.
message e386(00) with 'Error al desbloquear Entrega' i_datos-vbeln.
ENDIF.
commit work and wait.

suma = 0.
loop at i_mchbtemp where vbeln = i_datos-vbeln
and posnr = i_datos-posnr.
suma = suma + i_mcHbtemp-clabs2.
endloop.
"verificamos que la suma de los lotes sea igual a la cantidad que
"necesita la posicion
if suma = i_datos-lfimg.
"modificamos posicion
perform f_modpos.
else.
message e368(00) with 'No concuerda' suma ' con ' i_datos-lfimg.
endif.
endloop.

leave program.
ENDFORM. " f_modificaentrega
*&---------------------------------------------------------------------*
*& Form f_modpos
*&---------------------------------------------------------------------*
* Modifica una posicion en la entrega una vez que se traspaso material
*----------------------------------------------------------------------*
* --> p1 text
* <-- p2 text
*----------------------------------------------------------------------*
FORM f_modpos.
"verifica si es posicion delas miles si es asi borrala y modifica la
"original
data ymeins like mara-meins.
data zmeins(10).


REFRESH BDC_TAB.
*METERMOS NUMERO DE ENTREGA
perform DYNPRO using 'X' 'SAPMV50A' '4004'.
perform DYNPRO using '' 'BDC_CURSOR'
'LIKP-VBELN'.
perform DYNPRO using '' 'BDC_OKCODE'
'/00'.
perform DYNPRO using '' 'LIKP-VBELN'
I_DATOS-VBELN.
*IR A LA PESTAÑA DE PICKING
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=T\02'.


*SI ES POSICION DE LAS 1000 LA BORRAMOS
if i_datos-posnr > 1000 and i_datos-posnr < 2000 .
*BUSCAR POSICION DE LAS 1000
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=POPO_T'.
perform DYNPRO using 'X' 'SAPMV50A' '0111'.
perform DYNPRO using '' 'BDC_CURSOR'
'RV50A-POSNR
'.
perform DYNPRO using '' 'BDC_OKCODE'
'=WEIT'.
perform DYNPRO using '' 'RV50A-POSNR'
I_DATOS-POSNR.
*BORRAR POSICION DE LAS 1000
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=POLO_T'.
perform DYNPRO using '' 'BDC_CURSOR'
'LIPS-POSNR(01)'.
perform DYNPRO using '' 'RV50A-LIPS_SELKZ(01)'
'X'.
i_datos-posnr = i_datos-posnr - 1000.
endif.



*BUSCAR POSICION ORIGINAL
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=POPO_T'.

perform DYNPRO using 'X' 'SAPMV50A' '0111'.
perform DYNPRO using '' 'BDC_CURSOR'
'RV50A-POSNR'.
perform DYNPRO using '' 'BDC_OKCODE'
'=WEIT'.
perform DYNPRO using '' 'RV50A-POSNR'
I_DATOS-POSNR.
*CAMBIAR VALORES DE LA LINEA
perform DYNPRO using 'X' 'SAPMV50A' '1000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=CHSP_T'.
perform DYNPRO using '' 'LIPSD-G_LFIMG(01)'
i_datos-lfimg.
perform DYNPRO using '' 'LIPSD-PIKMG(01)'
i_datos-lfimg.
read table i_mchbtemp with key vbeln = i_datos-vbeln posnr =
i_datos-posnr.
perform DYNPRO using '' 'LIPS-LGORT(01)'
I_mchbtemp-LGORT2.

*HACER EL PICKING A LA POSICION
loop at i_mchbtemp where vbeln = i_datos-vbeln
and posnr = i_datos-posnr.

select single meins into ymeins from mara where matnr = i_datos-matnr.
write ymeins to zmeins.
perform DYNPRO using 'X' 'SAPMV50A' '3000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=POAN_T'.
perform DYNPRO using '' 'LIPS-CHARG(01)'
I_MCHBTEMP-CHARG2.
perform DYNPRO using '' 'LIPS-LGORT(01)'
I_MCHBTEMP-LGORT2.
perform DYNPRO using '' 'LIPS-LFIMG(01)'
I_MCHBTEMP-CLABS2.
perform DYNPRO using '' 'LIPS-VRKME(01)'
zMEINS.
endloop.

*PARA CADA LINEA DE LOTE AGREGARLA
perform DYNPRO using 'X' 'SAPMV50A' '3000'.
perform DYNPRO using '' 'BDC_OKCODE'
'=SICH_T'.

*LLAMA A LA TRANSACCION
CALL TRANSACTION 'VL02N' USING BDC_TAB MODE MODO.

if sy-subrc = 0.
message i368(00) with 'Se han modificado la entrega ' i_datos-vbeln
' posicion ' i_datos-posnr .


endif.


ENDFORM. " f_modpos

Macro de excel

Sub Macro3()
' Macro de excel que mueve datos de un sheet a otro
' Macro3 Macro
'
' Keyboard Shortcut: Ctrl+w
'
Dim codigo As String
Dim direc As String
Dim num1 As Integer
Dim num2 As Integer
Dim num3 As Integer
Dim num4 As Integer

Sheets("Input Data").Select
[A2].Select
dato1 = "activo"
Do While Not IsEmpty(dato1)
Sheets("Input Data").Select
codigo = ActiveCell
num2 = 0
'ActiveCell.Offset(num1, num2).Select
dato1 = ActiveCell.Offset(num1, num2)
If Not IsEmpty(dato1) Then
num2 = num2 + 1
dato2 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato3 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato4 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato5 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato6 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato7 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato8 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato9 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato10 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato11 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato12 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato13 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato14 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato15 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato16 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato17 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato18 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato19 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1
dato20 = ActiveCell.Offset(num1, num2)
num2 = num2 + 1


Sheets("Upload").Select
[A1].Select
num2 = 0
ActiveCell.Offset(num3, num2) = "H"
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato3
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato2
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato5
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato4
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato6
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato8
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato10

num3 = num3 + 1
num2 = 0
ActiveCell.Offset(num3, num2) = "R"
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato1
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato7 * -1
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato13
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato7 * -1
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato8
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato16
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato14
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato5


num3 = num3 + 1
num2 = 0
ActiveCell.Offset(num3, num2) = "G"
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato11
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato12
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato13
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato12
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato15
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato16
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato14
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato5
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = ""
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato17


num3 = num3 + 1
num2 = 0
ActiveCell.Offset(num3, num2) = "T"
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = 0
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = 0
num2 = num2 + 1
ActiveCell.Offset(num3, num2) = dato13
num3 = num3 + 1
num1 = num1 + 1
End If
Loop

End Sub

Reporte ABAP imprime las direcciones de correo de clientes

*PROGRAMA QUE IMPRIME LAS DIRECCIONES DE CORREO DE LOS CLIENTES
REPORT ZDIR.
data i_kna1 like kna1 occurs 0 with header line.
data i_adr6 like adr6 occurs 0 with header line.

select * from kna1 into table i_kna1.

select * from adr6 into table i_adr6 for all entries in i_kna1
where addrnumber = i_kna1-adrnr.

loop at i_kna1.
read table i_adr6 with key addrnumber = i_kna1-adrnr.
if sy-subrc <> 0.
i_adr6-smtp_addr = ''.
endif.
write : / i_kna1-kunnr ,i_kna1-stcd1, i_kna1-name1, i_kna1-name2,
i_adr6-smtp_addr.
endloop.