>EXPORT TO (cExcelFileName) type XLS >>
* 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 EndfuncCetin