FINAL: Text file => both Excel and Access db file

[spl]

This is more or less a script for all steps related to my previous post. To review, the challenge I got was to parse a text file into a typed persisted recordset that could be later imported into a formatted Excel file or database file. The final script below [with test text file attached] Will perform up to 3 udf functions depending on if

• original text file exists
• if persisted recordset or excel file do not exist

The output is then a table in a newly created Access Database. Of course, an assumption is made that Office is installed and suggests using 64bit WB to run, again assuming Office 10-11. This could all be done with Powershell, but WB was easier to code, and if a GUI needed would be easier to create [Powershell would need either Windows Forms, or XAML].

Anyway, hope it can be tested and validated it works [as given]

Code Select Expand

;Winbatch - 2022C - Text file => Excel and Access Table as typed
;3 udfs
;  buildrs() - parses text file into data-type mspersist recordset file
;  buildxl() - Creates typed Excel file from persisted recordset
;  builddb() - Creates Blank Access db and inserts into table from Excel file
;  sample text file used for coding, but could be re-coded for any text
;  builddb() creates a blank access file and inserts a table
;            could be adapted for SQLServer or SQLite
;
;  tested to run as WB 64bit
;Stan Littlefield 6/9/2024
;========================================================================================
IntControl(73,1,0,0,0)
gosub udfs
Display(2,"Begin","Parsing text file into Excel/Access Table")
;base variables
fname = "testdata"
ext = ".txt"

;quit if missing text/csv file
textfile =  dirscript():fname:ext
If ! FileExist(textfile) Then Terminate(@TRUE"File Missing",textfile)

cXLS = dirscript():fname:".xlsx"
accdb = dirscript():fname:".accdb"



;choice of output for persisted recordset
method = 1   ;1 for xml or 0 for adtg binary output, about 1/2 size of xml
If method == 1
   outfile = dirscript():fname:".xml"
Else
   outfile = dirscript():fname:".adtg"
Endif

If ! FileExist(outfile) Then buildrs() ;function will require modification
                                              ;based on text file syntax


keeppretty = @TRUE ;if @TRUE pretty formatted Excel will be created
                     ;otherwise basic excel saved and removed after access table created
If ! FileExist(cXLS) Then buildxl()

doaccdb = @TRUE

If doaccdb
   
   ;build access table, delete if it already exists
   If FileExist(accdb) Then FileDelete(accdb)
   builddb()
   Message("Finished",outfile:" parsed and inserted into ":accdb)
Endif

Exit

:WBERRORHANDLER
geterror()
Message("Error Encountered",errmsg)
Exit



;========================================================================================

:udfs
#DefineSubRoutine geterror()
   wberroradditionalinfo = wberrorarray[6]
   lasterr = wberrorarray[0]
   handlerline = wberrorarray[1]
   textstring = wberrorarray[5]
   linenumber = wberrorarray[8]
   errmsg = "Error: ":lasterr:@LF:textstring:@LF:"Line (":linenumber:")":@LF:wberroradditionalinfo
   Return(errmsg)
#EndSubRoutine

#DefineSubRoutine buildrs()
IntControl(73,1,0,0,0)
numcols=6
numlines=6
Display(2,"Creating...",outfile)
oRS = Createobject("ADODB.Recordset")
oRS.Fields.Append("Product_Code", 129, 20)
oRS.Fields.Append("Season", 129, 20)
oRS.Fields.Append("Product", 129, 20)
oRS.Fields.Append("Product_Type", 129, 20)
oRS.Fields.Append("Product_Color", 129, 10)
oRS.Fields.Append("Product_Size", 129, 10)
oRS.Fields.Append("Sales_Date", 7)    ;create a date type
oRS.Fields.Append("Customer_Code", 129, 20)
oRS.Fields.Append("SalesQty", 3)    ;create an integer type
oRS.Fields.Append("Price", 6)         ;create a decimal type

oRS.Open()
oRS.Save(outfile,method)
oRS.Close()
oRS.Open(outfile,"Provider=MsPersist",1,3,256)
Display(1,"Creating...","Recordset Created")
TimeDelay(1)

h=FileOpen(cFile,"READ")
line = FileRead(h) ;skip header row
While @True
   line = FileRead(h)
   If line == "*EOF*" Then Break
   Display(1,"Processing...",line)  ;not really needed for large files
   oRS.Addnew()
   oRS.Collect("Product_Code")=ItemExtract(1,line,"-")
   oRS.Collect("Sales_Date")=fmtdate(ItemExtract(3,line,"-"))
   oRS.Collect("Customer_Code")=ItemExtract(4,line,"-")
   oRS.Collect("SalesQty")=ItemExtract(5,line,"-")
   oRS.Collect("Price")=ItemExtract(6,line,"-")
   
   inline = ItemExtract(2,line,"-")
   oRS.Collect("Season")=ItemExtract(1,inline," "):"/":ItemExtract(2,inline," ")
   oRS.Collect("Product")=ItemExtract(3,inline," ")
   oRS.Collect("Product_Type")=ItemExtract(4,inline," ")
   oRS.Collect("Product_Color")=ItemExtract(5,inline," ")
   oRS.Collect("Product_Size")=ItemExtract(6,inline," ")
   oRS.Update()
Endwhile
FileClose(h)

oRS.Save(outfile,method)
oRS.Close()
oRS=0
If FileExist(outfile)
   Display(2,"File Created",outfile)
Else
   Terminate(@TRUE,"Cannot Continue",cXLS:" could not be created")
Endif
Return(@TRUE)

:WBERRORHANDLER
geterror()
Message("Error Encountered",errmsg)
Exit
#EndSubRoutine

#DefineSubRoutine buildxl()
IntControl(73,1,0,0,0)
oRS = Createobject("ADODB.Recordset")
oRS.Open(outfile,"Provider=MsPersist",1,4,256)
Display(2,"Importing Recordset to Excel","Please Wait")

oXL = CreateObject("Excel.Application")
Display(2,"Opening...","Creating Excel Workbook ":cXLS)
oXL.Visible          = @TRUE  ; change this to @FALSE to run hidden
oXL.ScreenUpdating   = @TRUE  ; if running hidden, change this to @FALSE
oXL.UserControl      = @TRUE
oXL.DisplayAlerts    = @FALSE
oXL.WorkBooks.Add()
oWS = oXL.ActiveWorkBook.Worksheets(1)
oWS.Activate()
oWS.Name = fname
Display(2,"Populating...","Creating Excel Columns")
If ! oRS.Eof()
  n=oRS.Fields.Count
  r=1
  For i=0 To n-1
     oWS.Cells(r,i+1).Value=oRS.Fields(i).Name
  Next
  oWS.Range("A2").CopyFromRecordset(oRS)
  oWS.UsedRange.Select()
  If keeppretty
     oXL.Selection.Font.Name = 'Tahoma'
     oXL.Selection.Font.Size = 9
     oXL.Selection.Font.Bold = @True
     oWS.UsedRange.Columns.Autofit()
     oWS.ListObjects.Add(:1,oWS.UsedRange, , 1).Name ="Table1"
     oWS.Range("Table1[#All]").Select()
     oWS.ListObjects("Table1").TableStyle = "TableStyleLight15"  ;or set tablestyle up as variable
     oXL.ActiveWindow.DisplayGridlines = @False
  Endif
Else
   oRS.Close()
   oRS=0
   Terminate(@TRUE,"Error","Recordset was Empty")
Endif
oRS.Close()
oRS=0
oXL.ActiveWorkBook.SaveAS(cXLS,51)
oXL.Quit() 
oXL=0   

Return(@TRUE)

:WBERRORHANDLER
geterror()
Message("Error Encountered",errmsg)
Exit
#EndSubRoutine

#DefineSubRoutine builddb()
IntControl(73,1,0,0,0)
cat= CreateObject("ADOX.Catalog")
conn = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=":accdb
cat.Create(conn)
cat.activeConnection.close()
cat=0
If FileExist(accdb)
   Display(2,"Database Created",accdb)
Else
   Terminate(@TRUE,"Closing...","Database Not Created")
Endif
conn = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=":accdb
oConn = CreateObject("ADODB.Connection")
oConn.ConnectionTimeOut=0
oConn.CursorLocation=3
oConn.Open(conn)
Display(2,"Inserting into New Table",cXLS)
oConn.Execute("SELECT * INTO [testdata] FROM [testdata$] IN '' [Excel 12.0 xml;DATABASE=%cXLS%;HDR=YES;IMEX=1];")
oConn.Close()
oConn = 0
   
If ! keeppretty Then FileDelete(cXLS)
Return(@TRUE)

:WBERRORHANDLER
geterror()
Message("Error Encountered",errmsg)
Exit
#EndSubRoutine


Return
;========================================================================================