Need suggestions for Recordset Creation

[spl]

I got a challenge to create a saved recordset (xml) from a text file [attached] useful to be SELECTED or INSERTED into Access, or SQL Server, or SQLITE, or Oracle.. There are only 20 rows in the attached text, with this format

Code Select Expand

Product_Code-Product_Description-Sales_Date-Customer_Code-Sales_Qty-Price
10125061-Autumn Winter trouser Classic Grey Small-10/05/2023-17908394-1-29.95
10125061-Autumn Winter trouser Classic Grey Medium-03/02/2023-23269166-30-29.95
10125061-Autumn Winter trouser Classic Grey Small-11/20/2022-27268745-3-29.95

The ask was to break the Product_Description into fields for season,product,product_type,Product_color and product_size. 

Appreciate anyone running the code below with the attached file to ensure it works. Then I would really appreciate advice for better formatting. While recordset column types for sales_date, qty and price can be set to date, integer, decimal, my attempts to add the data to those column types would fail - the exception being price but the decimal value not rounded correctly when you view the xml. So both the date and qty are set as string and the code has options to comment/uncomment to set getting the data formatted properly. The CLR can use  .NET 'recordsets' with the MSpersist provider and that may be a better option, but I would think it should work the ADODB.

Please, test, comment, criticize.

Code Select Expand

;Winbatch - 2022C - Create Recordset from text file
;Stan Littlefield 6/6/2024
;========================================================================================
IntControl(73,1,0,0,0)
gosub udfs
cXML=dirscript():"testdata.xml"
cFile=  dirscript():"testdata.txt"
If ! FileExist(cFile) Then Terminate(@TRUE"File Missing",cFile)
If FileExist(cXML) Then FileDelete(cXML)
numcols=6
numlines=6
Display(1,"Creating...",cXML)
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("Sales_Date", 129,12)

oRS.Fields.Append("Customer_Code", 129, 20)

;oRS.Fields.Append("SalesQty", 131)    ;create an integer type
oRS.Fields.Append("SalesQty", 129, 4)

oRS.Fields.Append("Price", 5)         ;create a decimal type
;oRS.Fields.Append("Price", 129, 10)

oRS.Open()
oRS.Save(cXML,1)
oRS.Close()
oRS.Open(cXML,"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
   oRS.Addnew()
   oRS.Collect("Product_Code")=ItemExtract(1,line,"-")
   
   oRS.Collect("Sales_Date")=ItemExtract(3,line,"-")
   ;oRS.Collect("Sales_Date")=ObjectType("date",ItemExtract(3,line,"-"))  ;will not work
   
   oRS.Collect("Customer_Code")=ItemExtract(4,line,"-")

   ;oRS.Collect("SalesQty")=ObjectType("I1",ItemExtract(5,line,"-"))  ;will not work
   oRS.Collect("SalesQty")=ItemExtract(5,line,"-")
   
   oRS.Collect("Price")=ObjectType("decimal",ItemExtract(6,line,"-"))  ;works but not to 2 decimal places
   ;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(cXML,1)
oRS.Close()
oRS=0
If FileExist(cXML) Then Display(2,"File Created",cXML)
Exit

:WBERRORHANDLER
IntControl(73,1,0,0,0)
geterror()
oRS=0
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

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


[spl]

Took a closer look at the text data and

• adjusted the column type for qty and price
• adjusted the mm/dd/yyy format to YYYY:MM:dd and created a UDF for ObjectType return

updated text file attached, and updated script below

Code Select Expand

;Winbatch - 2022C - Create Recordset from text file
;Stan Littlefield 6/6/2024
;========================================================================================
IntControl(73,1,0,0,0)
gosub udfs

cXML=dirscript():"testdata.xml"
cFile=  dirscript():"testdata.txt"
If ! FileExist(cFile) Then Terminate(@TRUE"File Missing",cFile)
If FileExist(cXML) Then FileDelete(cXML)
numcols=6
numlines=6
Display(1,"Creating...",cXML)
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(cXML,1)
oRS.Close()
oRS.Open(cXML,"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
   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(cXML,1)
oRS.Close()
oRS=0
If FileExist(cXML) Then Display(2,"File Created",cXML)
Exit

:WBERRORHANDLER
IntControl(73,1,0,0,0)
geterror()
oRS=0
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

#DefineFunction fmtdate(d)
d1 = Strsub(d,7,4):":":Strsub(d,1,2):":":Strsub(d,4,2)
Return(ObjectType("DATE",d1))
#EndFunction

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


[JTaylor]

Ran fine for me.  Did you work out your problems?   Things looked okay on my side.

Jim

[spl]

Ran fine for me.  Did you work out your problems?  Things looked okay on my side.

Jim

Jim. Appreciate you taking the time. When I was given the challenge I recognized the sample data was from the Microsoft Contoso sample database. The ask was to see if I still had any WB skills. The purpose goes back to stuff I used to do 15 years ago, which was to email/send typed recordsets to users rather than .csv or .txt files. And, the recordset could be saved as ADTG [a binary format over 1/2 size of xml]. For you or anyone else who could find 5 minutes to test

• updated create code to save as either xml or adtg
• sample code to reconstruct recordset as formatted Excel

Code Select Expand

;Winbatch - 2022C - Create Recordset from text file
;Stan Littlefield 6/6/2024
;========================================================================================
IntControl(73,1,0,0,0)
gosub udfs

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

cFile=  dirscript():"testdata.txt"
If ! FileExist(cFile) Then Terminate(@TRUE"File Missing",cFile)
If FileExist(outfile) Then FileDelete(outfile)
numcols=6
numlines=6
Display(1,"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
   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) Then Display(2,"File Created",outfile)
Exit

:WBERRORHANDLER
IntControl(73,1,0,0,0)
geterror()
oRS=0
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

#DefineFunction fmtdate(d)
d1 = ItemExtract(3,d,"/"):"-":ItemExtract(1,d,"/"):"-":ItemExtract(2,d,"/")
Return(d1)
#EndFunction

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


Code Select Expand

;Winbatch - 2022C - Import persisted Recordset to Excel
;Stan Littlefield 6/6/2024
;========================================================================================
IntControl(73,1,0,0,0)
gosub udfs


method = 0   ;1 for xml or 0 for adtg binary output, about 1/2 size of xml
If method == 1
   outfile = dirscript():"testdata.xml"
Else
   outfile = dirscript():"testdata.adtg"
Endif
If ! FileExist(outfile) Then Terminate(@TRUE"File Missing",outfile)

oRS = Createobject("ADODB.Recordset")
oRS.Open(outfile,"Provider=MsPersist",1,3,256)
Display(2,"Importing Recordset to Excel",outfile)

oXL = CreateObject("Excel.Application")
Display(2,"Opening...","Creating Blank Excel Workbook")
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 = "testdata"
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()
  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
Else
  Display(2,"Error","Recordset was Empty")
Endif
oRS.Close()
oRS=0
;oXL.Quit  ;you could run a save first then quit
oXL=0
Message("Done","Save or Discard Excel File")
Exit 
 
:WBERRORHANDLER
IntControl(73,1,0,0,0)
geterror()
oRS=0
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

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


[JTaylor]

Seems to run fine.