Power Query w/csv

Started by stanl, April 18, 2021, 05:11:52 AM

Previous topic - Next topic

stanl


This is pretty much the same process as the previous thread Insert Code which had a Web url as the source. The script transforms .csv data into a Pivot, saves the Excel file and creates an outlook email. [files associated with script attached as agents.zip]. The .csv is very limited but I have tested with 1/4 million rows. Creating and using M code text files is going to prove useful to a variety of large source data. Say what you want about Excel, but Power Query/Power BI can compete with products like Tableau.


Code (WINBATCH) Select


;Winbatch 2020b - Testing Excel Power Query => Outlook 
;Requires Excel 2016 or Higher or Power Query added to Excel 2013 or earlier
;Script uses .csv file as source
;M code performs Pivot on ID column
;Variables and support files referenced from .cfg file
;Stan Littlefield  April 18, 2021
IntControl(73,1,0,0,0)
gosub udfs


types="Config Files|*.cfg|"
cCfg=AskFilename("Select Config File",dirscript(), types, "", 101)
cFile = Dirscript():IniReadPvt("Main","file","",cCFG)
cXLS = Dirscript():IniReadPvt("Main","xl","",cCFG) 
cMcode = Dirscript():IniReadPvt("Main","mc","",cCFG)
html =  Dirscript():IniReadPvt("Main","ht","",cCFG)
qry = IniReadPvt("Main","q","test.txt",cCFG)
If FileExist(cXLS) Then FileDelete(cXLS)
If ! FileExist(cFile) Then Terminate(@TRUE,"Cannot Continue, Source file ",cFile:" not found")
If ! FileExist(cMcode) Then Terminate(@TRUE,"Cannot Continue",cMcode:" not found")
If ! FileExist(html) Then Terminate(@TRUE,"Cannot Continue",html:" not found")
clip=@FALSE
cn = "Query - ":qry
newcode = FileGet(cMcode)
newcode = StrReplace(newcode,"|file|",cFile)
BoxOpen("Please Wait","Creating Excel Power Query Web Connection")
oXL = CreateObject("Excel.Application")
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()
BoxShut()
oWS = oXL.ActiveWorkBook.Worksheets(1)
oWS.Activate()
oWS.Name = qry
BoxOpen("Please Wait","Creating Query/Saving Workbook/Then Close Excel")
oXL.ActiveWorkBook.Queries.Add(::Name=qry,Formula=newcode,Description="Agents Query")
;at this point the connection is created but data not sent to worksheet
;create a ListObject with OLEDB connection string
cSource = "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=%qry%;Extended Properties=''"
qt = oWS.ListObjects.Add(::SourceType=0,Source=cSource,Destination=oWS.Range("$A$1")).QueryTable
qt.CommandText = "Select * FROM [%qry%]"
qt.Refresh()
;may take some time but should save
oXL.ActiveWorkbook.SaveAs(cXLS)
oWS.UsedRange.Select()
oXL.Selection.CopyPicture(1,2)
clip=@TRUE
oXL.ActiveWorkbook.Close()
oXL.Quit()
BoxShut()
oWS=0
oXL=0
If fileexist(cXLS) Then createmail()
Exit


;======================================================================================================
:WBERRORHANDLER
Terminate(@TRUE,"Error Encountered",geterror())
;======================================================================================================


:CANCEL
Display(2,"Operation Canceled","Goodbye...")
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 createmail()
BoxOpen("Please Wait","Preparing Outloook Email")
cTo = IniReadPvt("Main","eto","Subject",cCFG)  ;use your own
cSub = IniReadPvt("Main","esub","Subject",cCFG)
data = cXLS
cBody = fileget(html) ;simple text with HTML wrappers
outlook = CreateObject("Outlook.Application")
email = outlook.CreateItem(0)
email.GetInspector.Activate()
BoxShut()
sSig = email.HTMLBody
email.To = cTo
email.Subject = cSub
email.HTMLBody =  cBody:sSig
If clip Then email.GetInspector.WordEditor.Range(0,0).Paste() ;comment to avoid error
email.Attachments.add(data)
;only show email
;email.Send()
ObjectClose(outlook)
outlook = 0
pause("Email Preview Created","Modify, send, or close as needed")
#EndSubRoutine


Return