HTML to Excel Converter

&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&&&&&&&
&&&&&&& 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='urn:schemas-microsoft-comfficeffice'>")
= 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="+Chr(34)+"urn:schemas-microsoft-comfficeffice"+Chr(34))
= Fput(tables2htmFile, "xmlns:x="+Chr(34)+"urn:schemas-microsoft-comffice: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