INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS
Log In
Come Join Us!
Are you a
Computer / IT professional?
Join Tek-Tips Forums!
- Talk With Other Members
- Be Notified Of Responses
To Your Posts
- Keyword Search
- One-Click Access To Your
Favorite Forums
- Automated Signatures
On Your Posts
- Best Of All, It's Free!
- Students Click Here
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.
Posting Guidelines
Promoting, selling, recruiting, coursework and thesis posting is forbidden. Students Click Here
|
COM and Automation
|
Export (groups of) DBFs to Excel Workbook QUICKLY by baltman
Posted: 9 Jan 03 (Edited 9 Feb 07)
|
&&&&&&&
&& Invoke this procedure by saving as a PRG file called "WBEXPORT"
&& In the command window type "SET PROCEDURE TO WBEXPORT"
&& And invoke the function by typing "tables2htm('TblName.dbf')"
&& or "tables2htm('Tbl*.dbf')" to export all DBFs starting with 'Tbl'
&&
&& This procedure scans the directory in which it resides for
&& the passsed value e.g. 'Tbl*.dbf' and exports all tables
&& meeting the criteria together into one HTM Excel workbook
&&
&& Works only with Excel 2000 and higher installed.
&&
&& Exports MEMO FIELDS AT THE SAME TIME AS OTHER FIELDS.
&&
&& Coded by Brian Altman
&&
&& Freeware with reservation to Copyrights
&& Last modified 1/26/2003
&&&&&&
FoxPro programming rocks!
Procedure tables2htm
Lparameters targetskeleton
Set Talk Off
cdir=Sys(5)+Curdir()+"tables2htm_files\"
If Directory(cdir)=.F.
Mkdir &cdir
Endif
&&224 stops too many sheets from being created
For workbookcount= 1 To Min(224,Adir(temparray1,targetskeleton))
targettable=temparray1(workbookcount,1)
outputfile=Left(temparray1(workbookcount,1),Len(temparray1(workbookcount,1))-4)+".htm"
HTMLFile=Fcreate(cdir+outputfile)
= Fput(HTMLFile, "<HTML>")
= Fput(HTMLFile, "<HEAD>")
= Fput(HTMLFile, "<META HTTP-EQUIV='Content-Type' CONTENT='text/html; charset=windows-1252'>")
= Fput(HTMLFile, "<META NAME='Generator' CONTENT='VFP'>")
= Fput(HTMLFile, "<TITLE>a</TITLE>")
= Fput(HTMLFile, "</HEAD>")
= Fput(HTMLFile, "<BODY>")
= Fput(HTMLFile, "<TABLE CELLSPACING=0 BORDER=0 CELLPADDING=3 WIDTH=264>")
= Fput(HTMLFile, "<TR><TD WIDTH='100%' VALIGN='TOP'>")
Use &targettable
For x = 1 To Afields(temparray2)
= Fput(HTMLFile,"<P>"+temparray2(x,1)+"</TD>")
= Fput(HTMLFile, "<TD>")
Endfor
= Fput(HTMLFile, "</TR>")
= Fput(HTMLFile, "<TR><TD>")
Scan
For x = 1 To Afields(temparray2)
cfield=temparray2(x,1)
Do Case
Case Type(cfield) $ "CM" && character,Memo fields
= Fput(HTMLFile,"<P>"+Iif(Alltrim(&cfield)="0","'","")+Alltrim(&cfield)+"</TD>")
Case Type(cfield) $ "YN" && numeric,currency fields
= Fput(HTMLFile,"<P>"+Alltrim(Str(&cfield,20,18))+"</TD>")
Case Type(cfield)="D" && date field
= Fput(HTMLFile,"<P>"+Substr(Dtos(&cfield),5,2)+"/"+Right(Dtos(&cfield),2)+"/"+Left(Dtos(&cfield),4)+"</TD>")
Case Type(cfield)="T"&& datetime fields
= Fput(HTMLFile,"<P>"+Ttoc(&cfield)+"</TD>")
Case Type(cfield)="L"&& logical fields
= Fput(HTMLFile,"<P>"+Iif(&cfield=.T.,"T","F")+"</TD>")
Otherwise && General fields
= Fput(HTMLFile,IIF(RECNO()=1,"<P>GENERAL FIELD</TD>",""))
Endcase
= Fput(HTMLFile, "<TD>")
Endfor
= Fput(HTMLFile, "</TR>")
= Fput(HTMLFile, "<TR><TD>")
Endscan
= Fput(HTMLFile, "</TABLE>")
= Fput(HTMLFile, "</BODY>")
= Fput(HTMLFile, "</HTML>")
=Fclose(HTMLFile)
Endfor
&&&&&&&END OF DBF TO HTML
&&&&&&& Create "filelist.xml"
XMLFile=Fcreate(cdir+"filelist.xml")
= Fput(XMLFile, "<xml xmlns:o='urn:schemas-microsoft-com:office:office'>")
= Fput(XMLFile, "<o:MainFile HRef='../tables2htm.htm'/>")
For workbookcount= 1 To Adir(temparray,targetskeleton)
inputfile=temparray(workbookcount,1)
outputfile=Left(temparray(workbookcount,1),Len(temparray(workbookcount,1))-4)+".htm"
= Fput(XMLFile, "<o:File HRef='"+outputfile+"'/>")
Endfor
= Fput(XMLFile, "<o:File HRef='filelist.xml'/>")
= Fput(XMLFile, "</xml>")
=Fclose(XMLFile)
&&&&&&& Create "tables2htm.htm" for Excel to open
tables2htmFile=Fcreate(Sys(5)+Curdir()+"tables2htm.htm")
= Fput(tables2htmFile, "<html xmlns:o="+Chr(34)+"urn:schemas-microsoft-com:office:office"+Chr(34))
= Fput(tables2htmFile, "xmlns:x="+Chr(34)+"urn:schemas-microsoft-com:office:excel"+Chr(34))
= Fput(tables2htmFile, "<head>")
= Fput(tables2htmFile, "<meta name="+Chr(34)+"Excel Workbook Frameset"+Chr(34)+">")
= Fput(tables2htmFile, "<meta http-equiv=Content-Type content="+Chr(34)+"text/html; charset=windows-1252"+Chr(34)+">")
= Fput(tables2htmFile, "<meta name=ProgId content=Excel.Sheet>")
= Fput(tables2htmFile, "<link rel=File-List href="+Chr(34)+"./tables2htm_files/filelist.xml"+Chr(34)+">")
= Fput(tables2htmFile, "<![endif]><!--[if gte mso 9]><xml>")
= Fput(tables2htmFile, "<x:ExcelWorkbook>")
= Fput(tables2htmFile, "<x:ExcelWorksheets>")
For workbookcount= 1 To Adir(temparray,targetskeleton)
tabname=Left(temparray(workbookcount,1),Len(temparray(workbookcount,1))-4)
= Fput(tables2htmFile, "<x:ExcelWorksheet>")
= Fput(tables2htmFile, "<x:Name>"+tabname+"</x:Name>")
= Fput(tables2htmFile, "<x:WorksheetSource HRef="+Chr(34)+"./tables2htm_files/"+tabname+".htm"+Chr(34)+"/>")
= Fput(tables2htmFile, "</x:ExcelWorksheet>")
Endfor
= Fput(tables2htmFile, "</x:ExcelWorkbook>")
= Fput(tables2htmFile, "</xml><![endif]-->")
= Fput(tables2htmFile, "</head>")
= Fput(tables2htmFile, "<noframes>")
= Fput(tables2htmFile, "<body>")
= Fput(tables2htmFile, "<p>This Export Requires Excel 2000 or higher.</p>")
= Fput(tables2htmFile, "</body>")
= Fput(tables2htmFile, "</noframes>")
= Fput(tables2htmFile, "</frameset>")
= Fput(tables2htmFile, "</html>")
=Fclose(tables2htmFile)
&&open with excel
Wait Window Nowait "Exporting Tables to Excel..."
lcOldError = On("ERROR")
On Error loExcel = .Null.
loExcel = Getobject(,"Excel.Application")
On Error &lcOldError
If Isnull(loExcel)
loExcel = Createobject("Excel.Application")
Endif
On Error
With loExcel
.WorkBooks.Open(Sys(5)+Curdir()+"tables2htm.htm")
For workbookcount= 1 To Min(224,Adir(temparray1,targetskeleton))
.Sheets(Left(temparray1(workbookcount,1),Len(temparray1(workbookcount,1))-4)).select
.ActiveWindow.DisplayGridlines = .t.
.ActiveWindow.Zoom = 75
Endfor
.Sheets(Left(temparray1(1,1),Len(temparray1(1,1))-4)).select
.Visible=.T.
Endwith
Set Talk On
Endproc |
Back to Microsoft: FoxPro FAQ Index
Back to Microsoft: FoxPro Forum
|
|
|
|
Talk To Other Members