I need to copy data from a cursor file in visual foxpro to and excel template
CodePudding user response：
You can use CopyFromRecordSet or QueryTables.Add. The problem with QueryTables.Add is:
- You need to have access to source data at all times. I mean you can't simply hand over your xls\xlsx file to someone else.
- You would need to use a driver to connect to VFP data, which is likely the VFPOLEDB driver, and it is 32 bits. Your excel might be 64 bits.
CopyFromRecordSet is a good choice IMHO, and you could use one of my VFP2Excel routines that have been posted on various forums many times. ie:
Select Cust_Id As CustomerId, ;
Val(Order_Id) As OrderId, ;
Order_Date As OrderDate, ;
Cast(Evl(Shipped_On, .Null.) As Datetime) As ShippedOn ;
From (_samples 'data\Orders') ;
Into Cursor crsToExcel ;
nofilter
*** We need real tables on disk to get them via VFPOLEDB
Local lcDbc, lcDBF
lcDbc = Forcepath( Forceext( Sys(2015), 'dbc'), Sys(2023))
lcDBF = Forcepath( Forceext(Sys(2015), 'dbf'), Sys(2023))
** Create the temp dbc
Create Database (m.lcDbc)
** and set it as the default database
Set Database To (m.lcDbc)
** and create tables from cursors as part of this new dbc
Select * From crsToExcel Into Table (m.lcDBF) Database (m.lcDbc)
Use In (Select(Juststem(m.lcDBF)))
Close Database
** Ready for sending the data to excel
** We also assume that the Excel on this machine could be a 64 bit version
** thus we don't do a direct VFPOLEDB transfer but wrap it in a ADODB.Stream
** We could as well use an ADODB.RecordSet
Local ix, loStream As 'Adodb.stream'
m.loStream = GetDataAsAdoStream("Provider=VFPOLEDB;Data Source=" m.lcDbc, Textmerge("select * from ('<< m.lcDBF >>')"))
*** Now that we have the data in streams, we can get rid of the temp database and tables
Local lcSafety
lcSafety = Set("Safety")
Set Safety Off
Delete Database (m.lcDbc) Deletetables
Set Safety &lcSafety
*** Main Excel automation part now
oExcel = Createobject("Excel.Application")
With oExcel
.DisplayAlerts = .F.
.Workbooks.Add
.Visible = .T.
With .ActiveWorkBook.ActiveSheet
.Name = 'SampleSheet'
* Send the data - copy to replacement
VFP2ExcelVariation(m.loStream, .Range("A1"), "Customer ID, Order ID, Ordered On, Shipped On")
.Columns.AutoFit()
.Activate
Endwith
Endwith
Function VFP2ExcelVariation(toStream, toRange, tcHeaders)
Local loRS As AdoDb.Recordset,ix
loRS = Createobject('Adodb.Recordset')
m.loRS.Open( m.toStream )
* Use first row for headers
Local Array aHeader[1]
m.toRange.Offset(1,0).CopyFromRecordSet( m.loRS ) && Copy data starting from headerrow 1
For ix=1 To Iif( !Empty(m.tcHeaders), ;
ALINES(aHeader, m.tcHeaders,1,','), ;
m.loRS.Fields.Count )
m.toRange.Offset(0,m.ix-1).Value = ;
Iif( !Empty(m.tcHeaders), ;
aHeader[m.ix], ;
Proper(m.loRS.Fields(m.ix-1).Name) )
m.toRange.Offset(0,m.ix-1).Font.Bold = .T.
Endfor
m.loRS.Close()
Endfunc
Procedure GetDataAsAdoStream(tcConnection, tcSQL)
Local loStream As 'AdoDb.Stream', ;
loConn As 'AdoDb.Connection', ;
loRS As 'AdoDb.Recordset'
loStream = Createobject('AdoDb.Stream')
loConn = Createobject("Adodb.connection")
loConn.ConnectionString = m.tcConnection
m.loConn.Open()
loRS = loConn.Execute(m.tcSQL)
m.loRS.Save( loStream )
m.loRS.Close
m.loConn.Close
Return m.loStream
Endproc
CodePudding user response：
A relatively easy way of creating Excel spreadsheets is the XML Spreadsheet format, or XMLSS for short. It is Microsoft's first attempt to add an XML format to Office products. XMLSS debuted with Office XP and is supported back to Office 2000.
Unlike in XLSX, which is a full replacement for the XLS format, you don't deal with multiple files compressed into a ZIP folder that XLSX is behind the scenes. It's also pretty straight forward to generate.
Excel opens the file without issues if you open it within Excel. Recent versions of Excel check wether the file extension matches the format. Excel expects an XML file extension for XMLSS files which isn't mapped to Excel by default. Therefore you cannot double-click a file in Explorer and expect it to open in Excel. An earlier work around was to rename the file to XLS, but that triggers a warning now when opening the file.
You can, however, use Excel automation to convert the XMLSS Excel file into a XLSX file.
Here's a very simple sample that converts the Northwind customer table into a spreadsheet with alternating coloring. The code would work with any open cursor if you remove the USE statement.
Use Northwind\Customers
Set Point To "."
Local lcFile
lcFile = GetEnv("USERPROFILE") "\Desktop\Customers.xls"
If File(m.lcFile)
Erase (m.lcFile)
EndIf
Local lcRows, lnField, luValue, lcStyle, lcData
lcRows = ""
Scan
lcRows = m.lcRows "<Row>"
For lnField = 1 to Fcount()
luValue = Evaluate(Field(m.lnField))
lcStyle = Iif(Recno()%2==0,"even","odd")
Do case
Case InList(Vartype(m.luValue),"C")
lcData = ;
[<Data ss:Type="String">] Strconv(Alltrim(m.luValue),9) [</Data>]
Case InList(Vartype(m.luValue),"N")
lcData = ;
[<Data ss:Type="Number">] Transform(Nvl(m.luValue,0)) [</Data]
Otherwise
Loop
EndCase
lcRows = m.lcRows ;
[<Cell ss:StyleID="] m.lcStyle [">] m.lcData [</Cell>]
EndFor
lcRows = m.lcRows "</Row>"
endscan
Local lcXML
Text to m.lcXML Noshow Textmerge
<?xml version="1.0"?>
<Workbook xmlns="urn:schemas-microsoft-com:office:spreadsheet"
xmlns:x="urn:schemas-microsoft-com:office:excel"
xmlns:ss="urn:schemas-microsoft-com:office:spreadsheet">
<Styles>
<Style ss:ID="even">
<Font ss:FontName="Tahoma" ss:Size="13" ss:Bold="1" />
</Style>
<Style ss:ID="odd">
<Font ss:FontName="Tahoma" ss:Size="13" ss:Color="red" />
</Style>
</Styles>
<Worksheet ss:Name="Sheet1">
<Table><<m.lcRows>></Table>
</Worksheet>
</Workbook>
EndText
StrToFile(m.lcXml,m.lcFile)
You find more information about XMLSS and potential issues you might run into in my Excelporting white paper.
The resulting file is not connected to the cursor or the data source in any way and therefore suitable to be sent around or be based on a cursor.