SAS Programming

art297 · Posted 10-13-2014 01:33 PM

A couple of weeks ago I asked for help comparing the exportxl macro with other methods for exporting Excel workbooks. The result was that the macro worked extremely well on stand-alone window's environments, but either worked slowly or failed to work altogether in EG and server environments.

I don't think the macro's performance can be improved for non-stand-alone environments, but I'd like to see if the changes I've made allow it to at least work where the previous version had failed. The macro uses VB script, thus is probably limited to Windows-based systems.

If you are on a server based Window's system would you please try run the following and let me know if it works? The two parameter settings you may have to change are the outfile and server_path parameters (in the call to the macro at the bottom of the following code) as the paths they describe have to exist (with write access) on your server.

Thanks in advance,

Art

%macro exportxl(data=,

outfile=,

sheet=,

type=N,

usenames=Y,

range=A1,

replace=Y,

template=,

templatesheet=,

useformats=N,

method=I,

server_path=);

/*Check whether the data and out parameters contain one or two-level filenames*/

%let lp=%sysfunc(findc(%superq(data),%str(%()));

%if &lp. %then %do;

%let dsoptions=%sysfunc(substrn(&data.,&lp));

%let data=%sysfunc(substrn(&data.,1,%eval(&lp-1)));

%end;

%else %let dsoptions=;

%if %sysfunc(countw(&data.)) eq 2 %then %do;

%let libnm=%scan(&data.,1);

%let filenm=%scan(&data.,2);

%end;

%else %do;

%let libnm=work;

%let filenm=&data.;

%end;

%if %length(&outfile.) lt 1 %then

%let outfile=%sysfunc(pathname(&libnm.))\&filenm..xlsx;;

%if %length(&sheet.) lt 1 %then

%let sheet=&filenm.;;

%if %upcase(&type.) eq P %then %do;

proc export

data=&libnm..&filenm. &dsoptions.

outfile= "&outfile."

dbms=excel

%if %upcase(&replace.) eq Y %then replace;

;

%if &sheet. ne "" %then sheet="&sheet.";;

run;

%end;

%else %do;

%if %upcase(&range.) eq Y %then %do;

data _null_;

window range rows=8 columns=80

irow=1 icolumn=2 color=black

#2 @3 'Enter the upper left cell where range should begin (e.g. D5): '

color=gray range $41. required=yes

attr=underline color=yellow;

DISPLAY range blank;

call symputx('range',range);

stop;

run;

%end;

%else %if %length(&range.) lt 2 %then %do;

%let range=A1;

%end;

%if %upcase(&template.) eq Y %then %do;

data _null_;

window template rows=8 columns=80

irow=1 icolumn=2 color=black

#2 @3 'Enter the template path and name: '

color=gray template $41. required=yes

attr=underline color=yellow;

DISPLAY template blank;

call symputx('template',template);

stop;

run;

%end;

%else %if %length(&template.) lt 2 %then %do;

%let template=;

%end;

%if %upcase(&templatesheet.) eq Y %then %do;

data _null_;

window templatesheet rows=8 columns=80

irow=1 icolumn=2 color=black

#2 @3 "Enter the template sheet's name: "

color=gray templatesheet $41. required=yes

attr=underline color=yellow;

DISPLAY templatesheet blank;

call symputx('templatesheet',templatesheet);

stop;

run;

%end;

%else %if %length(&templatesheet.) lt 2 %then %do;

%let templatesheet=;

%end;

data _null_;

dsid=open(catx('.',"&libnm.","&filenm."));

if dsid eq 0 then do;

rc=close(dsid);

link err;

end;

rc=close(dsid);

err:

do;

m = sysmsg();

put m;

stop;

end;

run;

data t_e_m_p;

set &libnm..&filenm. (obs=1);

run;

data t_e_m_p;

set t_e_m_p &dsoptions.;

run;

proc sql noprint;

select name,length,type,format,label

into :vnames separated by "~",

:vlengths separated by "~",

:vtypes separated by "~",

:vformats separated by "~",

:vlabels separated by "~"

from dictionary.columns

where libname="WORK" and

memname="T_E_M_P"

;

quit;

%let nvar=&sqlobs.;

filename code2inc temp;

data _null_;

file code2inc;

length script $80;

length fmt $32;

do i=1 to &nvar;

if i gt 1 then put 'rc=fput(fid,"09"x);';

%if %upcase(&useformats.) eq Y %then %do;

fmt=scan("&vformats.",i,"~","M");

%end;

%else call missing(fmt);;

if scan("&vtypes.",i,"~") eq 'char' then do;

if missing(fmt) then

fmt=catt('$',scan("&vlengths.",i,"~","M"),'.');

script=catt('rc=fput(fid,putc(put(',

scan("&vnames.",i,"~","M"),',',fmt,"),'$char",

scan("&vlengths.",i,"~","M"),".'));");

put script;

end;

else do;

if missing(fmt) then fmt='best32.';

script=catt('rc=fput(fid,putc(put(',

scan("&vnames.",i,"~","M"),',',fmt,"),'$char32.'));");

put script;

end;

put 'rc=fwrite(fid);';

run;

data _null_;

dsid=open("work.t_e_m_p");

rc=attrn(dsid,'any');

if rc ne 1 then do;

rc=close(dsid);

link err;

end;

rc=close(dsid);

err:

do;

m = sysmsg();

put m;

stop;

end;

run;

data _null_;

%if %length(&server_path.) gt 2 %then %do;

rc=filename('clippy',"&server_path.\clip.txt",'DISK');

%end;

%else %do;

rc=filename('clippy',' ','clipbrd');

%end;

if rc ne 0 then link err;

fid=fopen('clippy','o',0,'v');

if fid eq 0 then link err;

do i = 1 to &nvar.;

%if %upcase(&usenames.) ne N %then %do;

if i gt 1 then rc=fput(fid,'09'x);

%if %upcase(&usenames.) eq Y %then %do;

rc=fput(fid,scan("&vnames.",i,"~","M"));

%end;

%else %do;

if missing(scan("&vlabels.",i,"~","M")) then

rc=fput(fid,scan("&vnames.",i,"~"));

else rc=fput(fid,scan("&vlabels.",i,"~","M"));

%end;

end;

%if %upcase(&usenames.) ne N %then %do;

rc=fwrite(fid);;

%end;

do until (lastone);

set &libnm..&filenm. &dsoptions. end=lastone;

%include code2inc;

end;

rc=fclose(fid);

rc=filename('clippy');

rc=filename('code2inc');

stop;

err:

do;

m = sysmsg();

put m;

rc=filename('code2inc');

stop;

end;

run;

%if %upcase(&type.) eq N or %upcase(&type.) eq M

or %upcase(&type.) eq A %then %do;

%if %length(&server_path.) gt 2 %then %do;

data _null_;

length script filevar $256;

script = catx('\',pathname('WORK'),'PasteIt1.vbs');

filevar = script;

script="'"||'cscript "'||trim(script)||'"'||"'";

call symput('script',script);

file dummy1 filevar=filevar recfm=v lrecl=512;

put 'Dim objShell';

put 'Set objShell = CreateObject("WScript.Shell")';

script=catt('objShell.Run "notepad.exe'," &server_path.\clip.txt",'"');

put script;

put 'Do Until Success = True';