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!

*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.

Jobs

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: Visual FoxPro FAQ Index
Back to Microsoft: Visual FoxPro Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close