FoxPro/Visual FoxPro - !!!! SI LA SABE AYUDEME !!! P L E A S E

NECESITO ABRIR EXCEL DESDE UN PRG

Te envie un mail a tu cuenta porque no puedo enviar Datos ya que no me responde la www

Lo voy a pasar en varias notas porque es muy grande para colocarlo en una sola.

LOCAL nAnswer, ;
cError, ;
lErrorFlag, ;
lcProposedFileName, ;
lcFileName, ;
lcName, ;
lcTable, ;
lnOldSelect

IF "maintform" $ THISFORM.PARENTCLASS
lcTable = THIS.PARENT.GrdList.RECORDSOURCE
ELSE
lcTable = ALIAS()
ENDIF
lnOldSelect = SELECT()
SELECT( lcTable)

nAnswer = MESSAGEBOX(OPENEXCELFILE_LOC, ;
4+32, APPNAME_LOC)

IF nAnswer = 6
cError = ON("ERROR")

THISFORM.nExcelCount = THISFORM.nExcelCount + 1
lErrorFlag = .F.
ON ERROR lErrorFlag = .T.
THISFORM.oExcelApplication = CREATEOBJECT("Excel.Application")

IF lErrorFlag
SET STEP ON
ON ERROR &cError
MESSAGEBOX(CANTRUNEXCEL_LOC, 0 + 16, APPNAME_LOC)
SELECT (lnOldSelect)
RETURN
ENDIF

THISFORM.oExcelApplication.VISIBLE = .T.
THISFORM.oExcelWorkbook = THISFORM.oExcelApplication.WorkBooks

IF lErrorFlag
ON ERROR &cError
SET STEP ON
MESSAGEBOX(CANTOPENWORKBOOK_LOC, 0 + 16, APPNAME_LOC)
SELECT (lnOldSelect)
RETURN
ENDIF

IF "maintform" $ THISFORM.PARENTCLASS
lcName = STRTRAN(LEFT(THISFORM.CAPTION, LEN(THISFORM.CAPTION) -2), " ", "_")
ELSE
lcName = THISFORM.CAPTION
ENDIF

lcName = CHRTRAN( lcName, 'á', 'a')
lcName = CHRTRAN( lcName, 'é', 'e')
lcName = CHRTRAN( lcName, 'í', 'i')
lcName = CHRTRAN( lcName, 'ó', 'o')
lcName = CHRTRAN( lcName, 'ú', 'u')
lcName = CHRTRAN( lcName, ',', '_')

lcFileName = ALLTRIM(GoApp.GetSetting(EXCELDIR_KEY, APPCLASS)) + ;
lcName + ;
ALLTRIM(STR(THISFORM.nExcelCount)) + ".XLS"

SET SAFETY OFF
COPY TO ( lcFileName) TYPE XL5 FIELD EXCEPT *D
cError = ON("ERROR")

lErrorFlag = .F.
ON ERROR lErrorFlag = .T.
COPY TO ( lcFileName) TYPE XL5 FIELD EXCEPT *D
ON ERROR &cError
IF lErrorFlag
ERRORMSG("No se pudo generar la planilla, asegurece por favor que no esta siendo utilizada por una sesión de MS-Excel")
RETURN .F.
ENDIF

SET SAFETY ON

IF "maintform" $ THISFORM.PARENTCLASS
GO TOP
THISFORM.oBizObj.RecordPointerMoved()
THIS.PARENT.GrdList.SETFOCUS()
ENDIF

THISFORM.oExcelWorkbook.OPEN(lcFileName)
AFIELDS(tmpCursor)
toWorkSheet = THISFORM.oExcelApplication.ActiveSheet
cCursor = IIF(UPPER(SUBSTR(ALIAS(),1,2))="V_","l" + ALIAS(), ALIAS())
nRow = 0
DO WHILE .T.
nRow = nRow + 1
IF !EMPTY(toWorkSheet.CELLS(1,nRow).VALUE)
nPos = ASCAN(tmpCursor, UPPER(toWorkSheet.CELLS(1,nRow).VALUE))
toWorkSheet.CELLS(1,nRow).VALUE = DBGETPROP(cCursor + "." + tmpCursor(nPos), "FIELD","CAPTION")
ELSE
EXIT
ENDIF
ENDDO

IF lErrorFlag
ON ERROR &cError
AERROR[aErrorInfo]
SET STEP ON
MESSAGEBOX ( CANTOPENEXCELFILE_LOC + ;
aErrorInfo[2] + CHR(13) + aErrorInfo[3], ;
0 + 16, ;
APPNAME_LOC)
19:14:15
SELECT (lnOldSelect)
RETURN
ENDIF
SELECT (lnOldSelect)
RETURN
ENDIF

nAnswer = MESSAGEBOX( SAVEFILEEXCELFORMAT_LOC, ;
4 + 32,;
APPNAME_LOC)
IF nAnswer # 6
SELECT (lnOldSelect)
RETURN
ENDIF
lcName = STRTRAN(LEFT(THISFORM.CAPTION, LEN(THISFORM.CAPTION) -2), " ", "_")
lcProposedFileName = ALLTRIM(GoApp.GetSetting(EXCELDIR_KEY, APPCLASS)) + ;
lcName
lcFileName = PUTFILE(EXCELFILE_LOC, ;
lcProposedFileName ,;
"XLS")
IF EMPTY(lcFileName)
SELECT (lnOldSelect)
RETURN
ENDIF

SET SAFETY OFF
*-- COPY TO &lcFileName TYPE XL5
cError = ON("ERROR")
lErrorFlag = .F.
ON ERROR lErrorFlag = .T.
COPY TO ( lcFileName) TYPE XL5
ON ERROR &cError
IF lErrorFlag
ERRORMSG("No se pudo generar la planilla, asegurece por favor que no esta siendo utilizada por una sesión de MS-Excel")
ENDIF

SET SAFETY ON
*-- Copy to moves the pointer to the last record and
*-- not calling recordPointerMoved() would result in
*-- a do you want to save your changes question.
*-- bracket this code so that it's done only on mainforms
IF "maintform" $ THISFORM.PARENTCLASS
GO TOP
THISFORM.oBizObj.RecordPointerMoved()
THIS.PARENT.GrdList.SETFOCUS()
ENDIF
MESSAGEBOX (FILESAVEDAS_LOC + " " + lcFileName, ;
0 + 64, ;
APPNAME_LOC)