Reputation: 33

VFP Copying Cursors to Excel Sheets

I am trying to develop a piece of code that will allow me to write two cursors on separate excel sheets within the same workbook. So far I've been able to create and rename the sheets that I need however, I have been unable to find any useful guide on copying data to a specific sheet rather than to separate excel documents. Any advice you be greatly appreciated.

oExcel = CREATEOBJECT("Excel.application")
*Add Second Sheet
oWorkBook = oExcel.Workbooks.Add()
oWorkbook.Sheets.Add
oSheet = oWorkbook.ActiveSheet
*Move Sheet 2 to after Sheet 1
oSheet.Move(,oWorkbook.Sheets(2))
*Rename Sheet 2
oSheet.Name = "I & T"
oExcel.WorkSheets(1).activate
oSheetX = oWorkbook.ActiveSheet
*Rename Sheet 1
oExcel.ActiveSheet.Name = "X"

SELECT tester1
COPY TO oSheetX TYPE xls

SELECT tester2
COPY TO oSheet TYPE xls

oExcel.Visible = .t.

Upvotes: 1

Answers (1)

Cetin Basoz

Reputation: 23797

(A good site for VFP is foxite.com. That is one of the few sites that are still alive.)

You can use my VFP2Excel procedure for that. Few variations of it has been published particularly on foxite. This is a sample with procedures ready to put cursors into Excel at desired sheet\range (even 64 bits office). In this sample, 5 cursors are created, then first 2 are placed to sheets 1,2 and last 3 are placed on sheets 3. All you need is to create your cursors and with some automation pass them to Excel specifying their desired locations:

* 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
Endwith


* Author: Cetin Basoz
* This is based on earlier VFP2Excel function codes
* that has been published on the internet, at various sites
* since 2001. Not to be messed with others' code who named the same but has
* nothing to do with the approaches taken here (unless copy & pasted and claimed
* to be their own work, < s > that happens).
Procedure VFP2Excel(tcCursorName, toRange, tcHeaders, tnPrefferredWidthForMemo)
    * tcCursorName
    * toRange
    * tcHeaders: Optional. Defaults to field headers
    * tnPrefferredWidthForMemo: Optional. Default 80
    * Function VFP2Excel
    tcCursorName = Evl(m.tcCursorName,Alias())
    tnPrefferredWidthForMemo = Evl(m.tnPrefferredWidthForMemo,80)
    Local loConn As AdoDB.Connection, loRS As AdoDB.Recordset,;
        lcTemp,lcTempDb, oExcel,ix, lcFieldName, lcHeaders

    lnSelect = Select()
    lcTemp   = Forcepath(Sys(2015)+'.dbf',Sys(2023))
    lcTempDb = Forcepath(Sys(2015)+'.dbc',Sys(2023))

    Create Database (m.lcTempDb)
    Select * From (m.tcCursorName) Into Table (m.lcTemp) Database (m.lcTempDb)

    Local Array aMemo[1]
    Local nMemoCount
    nMemoCount = 0
    lcHeaders = ''
    For ix = 1 To Fcount()
        lcFieldName = Field(m.ix)
        If Type(Field(m.ix))='M'
            nMemoCount = m.nMemoCount + 1
            Dimension aMemo[m.nMemoCount]
            aMemo[m.nMemoCount] = m.ix
            Replace All &lcFieldName With Chrtran(&lcFieldName,Chr(13)+Chr(10),Chr(10))
        Endif
        lcHeaders = m.lcHeaders + Iif(Empty(m.lcHeaders),'',',')+Proper(m.lcFieldName)
    Endfor
    tcHeaders = Evl(m.tcHeaders,m.lcHeaders)

    Use In (Juststem(m.lcTemp))
    Close Databases
    Set Database To

    loStream = Createobject('AdoDb.Stream')
    loConn = Createobject('ADODB.Connection')
    loRS = Createobject("ADODB.Recordset")
    loConn.ConnectionString = "Provider=VFPOLEDB;Data Source="+m.lcTempDb
    loConn.Open()
    loRS = loConn.Execute("select * from "+m.lcTemp)
    loRS.Save( loStream )
    loRS.Close
    loConn.Close
    Erase (m.lcTemp)

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

    loRS.Open( loStream )
    toRange.Offset(1,0).CopyFromRecordSet( loRS )  && Copy data starting from headerrow + 1

    Set Safety Off
    Delete Database (m.lcTempDb) Deletetables

    Select (m.lnSelect)

    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

    #Define xlJustify                                         -4130
    #Define xlTop                                             -4160
    * This part is cosmetic
    toRange.WorkSheet.Activate
    With toRange.WorkSheet.UsedRange
        .VerticalAlignment = xlTop && set all to top
        For ix=1 To m.nMemoCount
            With .Columns(aMemo[m.ix])
                .ColumnWidth = m.tnPrefferredWidthForMemo && 80 chars width
                .WrapText = .T.
            Endwith
        Endfor
        .Columns.AutoFit
        .Rows.AutoFit
    Endwith
Endproc

* 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

EDIT: Probably you would want to put that VFP2Excel and _GetChar into their own .prg files, then for your cursors the code just becomes:

Local oExcel
oExcel = Createobject("Excel.Application")
With oExcel
    .DisplayAlerts = .F.
    .Workbooks.Add
    .Visible = .T.
    With .ActiveWorkBook
        For ix = 1 To 2 && We want 2 Sheets
            If .sheets.Count < m.ix
                .sheets.Add(,.sheets(.sheets.Count)) && Add new sheets
            Endif
        Endfor
        * Name the sheets
        .WorkSheets(1).Name = "X"
        .WorkSheets(2).Name = "I & T"

        * Start sending data

        VFP2Excel('Tester1',    .WorkSheets(1).Range("A1")) && To sheet1, start at A1
        VFP2Excel('Tester2',    .WorkSheets(2).Range("A1") ) && To sheet2, start at A1

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

        .WorkSheets(1).Activate
    Endwith
Endwith

Upvotes: 1

VFP Copying Cursors to Excel Sheets

Answers (1)

Related Questions