Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Easy way to convert cursor to .XLSX file including Heade
Message
From
05/06/2019 09:48:35
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
 
 
To
04/06/2019 13:34:28
Luis Santos
Biglevel-Soluções Informáticas, Lda
Portugal
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
01668894
Message ID:
01668926
Views:
99
>Hello Cetin,
>
>Thanks for your reply, but i have a Doubt about what i must put on tcDataSource, because Datasource are VFP cursor that i build,
>Could give me an example for a cursor instead Table.
>
>VFP2ExcelVariation(tcDataSource, tcSQL, toRange, tcHeaders)
>
>Also, if is possible to use in tcDataDource my cursor name like : MyCrs, what i must place in tcSQL variable, for example:
>select name, invoicedate, total from MyCrs.
>
>Best regards,
>Luis

Wish you checked the link I gave. This code was there already (the link at top of that thread):
* These represent complex SQL as a sample
Select emp_id,First_Name,Last_Name,;
  Title,Notes ;
  from (_samples+'\data\employee') ;
  into Cursor crsEmployee ;
  readwrite
Replace All Notes With Chrtran(Notes,Chr(13)+Chr(10),Chr(10))

Select cust_id,company,contact,Title,country,postalcode ;
  from (_samples+'\data\customer') ;
  into Cursor crsCustomer ;
  nofilter

Select * ;
  from (_samples+'\data\orders') ;
  into Cursor crsOrders ;
  nofilter

Select * ;
  from (_samples+'\data\orditems') ;
  into Cursor crsOrderDetail ;
  nofilter

Select * ;
  from (_samples+'\data\products') ;
  into Cursor crsProducts ;
  nofilter

* Now we want to get these on 3 sheets
* Sheet1: Employees only
* Sheet2: Customers only
* Sheet3: Orders, ordItems, Products layed out horizontally

Local oExcel
oExcel = Createobject("Excel.Application")
With oExcel
  .DisplayAlerts = .F.
  .Workbooks.Add
  .Visible = .T.
  With .ActiveWorkBook
    For ix = 1 To 3 && We want 3 Sheets
      If .sheets.Count < m.ix
        .sheets.Add(,.sheets(.sheets.Count)) && Add new sheets
      Endif
    Endfor
    * Name the sheets
    .WorkSheets(1).Name = "Employees"
    .WorkSheets(2).Name = "Customers"
    .WorkSheets(3).Name = "Order, OrderDetail, Products" && max sheetname is 31 chars

    * Start sending data
    * First one has headers specified
    VFP2Excel('crsEmployee',    .WorkSheets(1).Range("A1"), ;
      "Id,First Name,Last Name,Employee Title,Comments about employee" ) && To sheet1, start at A1
    VFP2Excel('crsCustomer',    .WorkSheets(2).Range("A1") ) && To sheet2, start at A1
    VFP2Excel('crsOrders',      .WorkSheets(3).Range("A1") ) && To sheet3, start at A1
    * Need to know where to put next
    * Leave 2 columns empty - something like 'G1'
    lcRange = _GetChar(.WorkSheets(3).UsedRange.Columns.Count + 3) + '1'
    * To sheet3, start at next to previous
    VFP2Excel('crsOrderDetail', .WorkSheets(3).Range(m.lcRange) )

    lcRange = _GetChar(.WorkSheets(3).UsedRange.Columns.Count + 3) + '1'
    * To sheet3, start at next to previous
    VFP2Excel('crsProducts',    .WorkSheets(3).Range(m.lcRange) )

    #Define xlJustify                                         -4130
    #Define xlTop                                             -4160

    * I just happen to know notes in at column 5 from SQL
    * No need to query from excel to keep code simple
    * Lets format that column specially instead of leaving
    * at the mercy of Excel's autofitting
    .WorkSheets(1).UsedRange.VerticalAlignment = xlTop && set all to top
    With .WorkSheets(1).Columns(5)
      .ColumnWidth = 80 && 80 chars width
      .WrapText = .T.
      *      .HorizontalAlignment = xlJustify && doesn't work good always
    Endwith

    * Finally some cosmetic stuff
    For ix=1 To 3
      With .WorkSheets(m.ix)
        .Columns.AutoFit
        .Rows.AutoFit
      Endwith
    Endfor

    .WorkSheets(1).Activate
  Endwith
  #Define xlWorkbookNormal                                  -4143
  * for another test save in current Excel version
  .ActiveWorkBook.SaveAs('c:\temp\ReadMeBack.xls',xlWorkbookNormal)
Endwith


* Warning:
* Copying to a free table (might be dbc based)
* temporarily and using field names as headers
* if not passed.
* This might lead to problems like:
* Truncated fieldnames of 2 columns collide and copy to errors
* Field names might be cryptic for the enduser
Function VFP2Excel
  Lparameters tcCursorName, toRange, tcHeaders
  tcCursorName = Iif(Empty(m.tcCursorName),Alias(),m.tcCursorName)
  Local loConn As AdoDB.Connection, loRS As AdoDB.Recordset,;
    lcTemp, oExcel,ix

  lcTemp = Forcepath(Sys(2015)+'.dbf',Sys(2023))
  Select (m.tcCursorName)
  Copy To (m.lcTemp)
  loConn = Createobject("Adodb.connection")
  loConn.ConnectionString = "Provider=VFPOLEDB;Data Source="+Sys(2023)
  loConn.Open()
  loRS = loConn.Execute("select * from "+m.lcTemp)

  * Use first row for headers
  Local Array aHeader[1]

  toRange.Offset(1,0).CopyFromRecordSet( loRS )  && Copy data starting from headerrow + 1
  For ix=1 To Iif( !Empty(m.tcHeaders), ;
      ALINES(aHeader, m.tcHeaders,1,','), ;
      loRS.Fields.Count )
    toRange.Offset(0,m.ix-1).Value = ;
      Iif( !Empty(m.tcHeaders), ;
      aHeader[m.ix], ;
      Proper(loRS.Fields(m.ix-1).Name) )
    toRange.Offset(0,m.ix-1).Font.Bold = .T.
  Endfor

  loRS.Close
  loConn.Close
  Erase (m.lcTemp)
Endfunc

* Return A, AA, BC etc noation for nth column
Function _GetChar
  Lparameters tnColumn && Convert tnvalue to Excel alpha notation
  If m.tnColumn = 0
    Return ""
  Endif
  If m.tnColumn <= 26
    Return Chr(Asc("A")-1+m.tnColumn)
  Else
    Return 	_GetChar(Int(Iif(m.tnColumn % 26 = 0,m.tnColumn - 1, m.tnColumn) / 26)) + ;
      _GetChar((m.tnColumn-1)%26+1)
  Endif
Endfunc
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Previous
Reply
Map
View

Click here to load this message in the networking platform