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]
;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
;========================================================================================