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

HTML to Excel Converter by baltman
Posted: 4 Nov 03 (Edited 4 Nov 03)

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&&                           
&&&&&&&    HTML to Excel Converter
&&&&&&&                             
&&&&&&&    Does not have any logic regarding
&&&&&&&    more than 254 Columns or worksheets
&&&&&&&    nor over 65K Rows.                        
&&&&&&&  
&&&&&&&    Copy and paste into a .PRG!
&&&&&&&                             
&&&&&&&    Brian Altman          
&&&&&&&                              
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&&
&&&&&&&  Built using VFP 7 and Office 2000
&&&&&&&  May not work on pre-VFP 7 Systems
&&&&&&&
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

PUBLIC oform1

oform1=NEWOBJECT("form1")
oform1.Show
RETURN


DEFINE CLASS form1 AS form
    Height = 296
    Width = 594
    AutoCenter = .T.
    Caption = "HTMLs to Excel Workbook Converter"
    Name = "Form1"

    ADD OBJECT text1 AS textbox WITH ;
        Height = 25, ;
        Left = 24, ;
        Top = 24, ;
        Width = 432, ;
        Name = "Text1"

    ADD OBJECT command1 AS commandbutton WITH ;
        Top = 24, ;
        Left = 468, ;
        Height = 25, ;
        Width = 120, ;
        Caption = "Get Directory", ;
        Name = "Command1"

    ADD OBJECT command2 AS commandbutton WITH ;
        Top = 240, ;
        Left = 336, ;
        Height = 37, ;
        Width = 120, ;
        Caption = "Convert to XL", ;
        Visible = .F., ;
        Name = "Command2"

    ADD OBJECT text2 AS textbox WITH ;
        Height = 25, ;
        Left = 24, ;
        Top = 60, ;
        Width = 96, ;
        Name = "Text2"

    ADD OBJECT list1 AS listbox WITH ;
        RowSourceType = 0, ;
        RowSource = "", ;
        ControlSource = "", ;
        Height = 132, ;
        Left = 24, ;
        Top = 96, ;
        Visible = .F., ;
        Width = 252, ;
        Name = "List1"

    ADD OBJECT list2 AS listbox WITH ;
        Height = 132, ;
        Left = 324, ;
        Top = 96, ;
        Visible = .F., ;
        Width = 253, ;
        Name = "List2"

    ADD OBJECT command3 AS commandbutton WITH ;
        Top = 132, ;
        Left = 288, ;
        Height = 25, ;
        Width = 25, ;
        Caption = ">", ;
        Visible = .F., ;
        Name = "Command3"

    ADD OBJECT command4 AS commandbutton WITH ;
        Top = 168, ;
        Left = 288, ;
        Height = 25, ;
        Width = 25, ;
        Caption = "<", ;
        Visible = .F., ;
        Name = "Command4"

    ADD OBJECT command5 AS commandbutton WITH ;
        Top = 96, ;
        Left = 288, ;
        Height = 25, ;
        Width = 25, ;
        Caption = ">>", ;
        Visible = .F., ;
        Name = "Command5"

    ADD OBJECT command6 AS commandbutton WITH ;
        Top = 204, ;
        Left = 288, ;
        Height = 25, ;
        Width = 25, ;
        Caption = "<<", ;
        Visible = .F., ;
        Name = "Command6"


    ADD OBJECT optiongroup1 AS optiongroup WITH ;
        ButtonCount = 2, ;
        Value = 1, ;
        Height = 42, ;
        Left = 123, ;
        Top = 52, ;
        Width = 57, ;
        Name = "Optiongroup1", ;
        Option1.Caption = "html", ;
        Option1.Value = 1, ;
        Option1.Height = 16, ;
        Option1.Left = 5, ;
        Option1.Top = 5, ;
        Option1.Width = 61, ;
        Option1.Name = "Option1", ;
        Option2.Caption = "htm", ;
        Option2.Height = 17, ;
        Option2.Left = 5, ;
        Option2.Top = 24, ;
        Option2.Width = 61, ;
        Option2.Name = "Option2"

    ADD OBJECT command7 AS commandbutton WITH ;
        Top = 240, ;
        Left = 468, ;
        Height = 37, ;
        Width = 109, ;
        Caption = "Quit", ;
        Name = "Command7"

    PROCEDURE Init
    thisform.text2.Value=".html"
    ENDPROC

    PROCEDURE Load
        RELEASE ALL &&forget stored variables
        PUBLIC gcHomedir
        gcHomedir=SYS(5)+SYS(2003)
    ENDPROC

    PROCEDURE Unload
        SET DEFAULT TO (gcHomedir)
    ENDPROC

    PROCEDURE Refresh
        SET DEFAULT TO (gcHomedir)
    ENDPROC

    PROCEDURE command1.Click
        cdir=GETDIR()

        thisform.text1.value=cdir

        SET DEFAULT TO &cdir
        arraycount=adir(harray,"*"+ALLTRIM(thisform.text2.value))

        IF arraycount>0
        thisform.list1.Visible= .T.
        thisform.list2.Visible= .T.
        thisform.command2.Visible= .T.
        thisform.command3.Visible= .T.
        thisform.command4.Visible= .T.
        thisform.command5.Visible= .T.
        thisform.command6.Visible= .T.
        thisform.list1.Clear
        thisform.list2.Clear

        FOR i = 1 TO arraycount
            IF lower(alltr(harray(i,1)))#"tables2htm.htm" AND "."+LOWER(JUSTEXT(alltr(harray(i,1))))==LOWER(ALLTRIM(thisform.text2.value))
               thisform.list1.AddListItem(harray(i,1),i)
               ENDIF
        ENDFOR
        ENDIF
        thisform.list1.refresh

        IF thisform.list1.ListCount=0
            messagebox("No files with that extension were found","Try Again",0)
        ENDIF
    ENDPROC

    PROCEDURE command2.Click
        cdir=SYS(5)+SYS(2003)
        exttype4array="'*"+ALLTRIM(UPPER(thisform.text2.Value))+"'"
        exttype=ALLTRIM(UPPER(thisform.text2.Value))

        IF thisform.list2.ListCount=0
            messagebox("No files Selected","Try Again",0)
            RETURN
        ENDIF

        &&start testing
        IF DIRECTORY(cdir+"\tables2htm_files")=.f.
        MKDIR (cdir+"\tables2htm_files")
        ELSE
        SET DEFAULT TO (cdir+"\tables2htm_files")
        FOR x=1 TO ADIR(temparray,&exttype4array)
        ERASE temparray(x,1)
        ENDFOR
        SET DEFAULT TO &cdir
        ENDIF

        For workbookcount= 1 TO thisform.list2.ListCount
        inputfile=ALLTRIM(thisform.text1.Value)+ALLTRIM(thisform.list2.listitem(workbookcount,1))
        COPY FILE &inputfile TO (cdir+"\tables2htm_files\"+ALLTRIM(thisform.list2.listitem(workbookcount,1)))
        ENDFOR

        &&&&&&& Create "filelist.xml"
        XMLFile=Fcreate(cdir+"\tables2htm_files\filelist.xml")
        = Fput(XMLFile, "<xml xmlns:o='urn:schemas-microsoft-com:office:office'>")
        = Fput(XMLFile, "<o:MainFile HRef='../tables2htm.htm'/>")

                For workbookcount= thisform.list2.ListCount TO 1 STEP -1
                     inputfile=ALLTRIM(thisform.text1.Value)+ALLTRIM(thisform.list2.listitem(workbookcount,1))
                    wboutputfile=ALLTRIM(thisform.list2.listitem(workbookcount,1))
                    = Fput(XMLFile, "<o:File HRef='"+wboutputfile+"'/>")
                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 thisform.list2.ListCount
                    tabname=JUSTSTEM(ALLTRIM(thisform.text1.Value)+ALLTRIM(thisform.list2.list(workbookcount)))
                    = Fput(tables2htmFile, "<x:ExcelWorksheet>")
                    = Fput(tables2htmFile, "<x:Name>"+tabname+"</x:Name>")
                    = Fput(tables2htmFile, "<x:WorksheetSource HRef="+Chr(34)+"./tables2htm_files/"+tabname+exttype+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, "</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
        .displayalerts=.f.
        .WorkBooks.Open(Sys(5)+Curdir()+"tables2htm.htm")
        .Visible=.T.
        .displayalerts=.t.
        Endwith
        Set Talk On

        SET DEFAULT TO (gcHomedir)

    ENDPROC

    PROCEDURE list1.DblClick
        varitem=thisform.list1.listitem(thisform.list1.ListItemId,1)

        IF LEN(ALLTRIM(varitem))>3
        thisform.list1.RemovelistItem(thisform.list1.ListItemId)
        thisform.list2.AddListItem(varitem)
        ENDIF
    ENDPROC

    PROCEDURE list2.DblClick
        varitem=thisform.list2.listitem(thisform.list2.ListItemId,1)

        IF LEN(ALLTRIM(varitem))>3
        thisform.list2.RemovelistItem(thisform.list2.ListItemId)
        thisform.list1.AddListItem(varitem)
        ENDIF
    ENDPROC

    PROCEDURE command3.Click
        varitem=thisform.list1.listitem(thisform.list1.ListItemId,1)

        IF LEN(ALLTRIM(varitem))>3
        thisform.list2.AddListItem(varitem)
        thisform.list1.RemovelistItem(thisform.list1.ListItemId)
        ENDIF
        thisform.refresh
    ENDPROC

    PROCEDURE command4.Click
        varitem=thisform.list2.listitem(thisform.list2.ListItemId,1)

        IF LEN(ALLTRIM(varitem))>3
        thisform.list1.AddListItem(varitem)
        thisform.list2.RemovelistItem(thisform.list2.ListItemId)
        ENDIF

        thisform.refresh
    ENDPROC

    PROCEDURE command5.Click
        counttocycle=(2+thisform.list1.ListCount)

        FOR i = 0 TO counttocycle
        thisvar="varitem"+TRANSFORM(i)
        &thisvar=thisForm.list1.ListItem(i)
        ENDFOR

        FOR i = 0 TO counttocycle
        thisvar="varitem"+TRANSFORM(i)

        IF LEN(ALLTRIM(&thisvar))>3
        thisform.list2.AddListItem(&thisvar)
        ENDIF

        ENDFOR

        thisform.list1.clear
    ENDPROC

    PROCEDURE command6.Click
        counttocycle=(2+thisform.list2.ListCount)

        FOR i = 0 TO counttocycle
        thisvar="varitem"+TRANSFORM(i)
        &thisvar=thisForm.list2.ListItem(i)
        ENDFOR

        FOR i = 0 TO counttocycle
        thisvar="varitem"+TRANSFORM(i)

        IF LEN(ALLTRIM(&thisvar))>3
        thisform.list1.AddListItem(&thisvar)
        ENDIF

        ENDFOR

        thisform.list2.clear
    ENDPROC

    PROCEDURE optiongroup1.InteractiveChange
        IF this.Value=1
        thisform.text2.value=".html"
        ELSE
        thisform.text2.value=".htm"
        ENDIF
    ENDPROC

    PROCEDURE command7.Click
        thisform.Release
    ENDPROC

ENDDEFINE

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