Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
That doesn't happen on MY machine
Message
 
To
21/12/2006 15:27:19
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Environment versions
Visual FoxPro:
VFP 6 SP3
OS:
Windows XP SP2
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01179645
Message ID:
01179670
Views:
11
>The button on the form has this code...
>
>DO m.dir+'progs\gues_label.prg'
>
>Then the program itself...(does some other stuff, then comes the Excel part)
>
>Select labels
>Set ORDER TO NAME
>Go TOP
>Count TO COUNT
>If COUNT>0
> m.newfile=m.dir+"data\labels.xls"
> Wait Clear
> oleApp = Createobject("Excel.Application") && Start Excel.
> oleApp.Workbooks.Add && Create a workbook.
> oleApp.DisplayAlerts=.f. &&GO SERGEY!!!!!!!!!
> oleapp.Sheets("Sheet3").Select
> oleapp.ActiveWindow.SelectedSheets.Delete
> oleapp.Sheets("Sheet2").Select
> oleapp.ActiveWindow.SelectedSheets.Delete
> Select labels
> Set order to name
> Go Top
> m.rownbr=1
> oleApp.cells(m.rownbr,1).Value="fname"
> oleApp.cells(m.rownbr,2).Value="name"
> m.rownbr=2
> Do While !Eof()
> Scatter Memvar Memo
> oleApp.cells(m.rownbr,1).Value=m.fname
> oleApp.cells(m.rownbr,2).Value=m.name
> m.rownbr=m.rownbr+1
> Select labels
> If !Eof()
> Skip 1
> If !Eof()
> Loop
> Endif
> Endif
> Enddo
> oleApp.ActiveWorkbook.SaveAs(m.newfile) && Save the workbook.
> oleApp.Quit &&Quit Excel
> oleApp.DisplayAlerts=.t.
> Wait Clear
>***************************
>Else
> Messagebox("Records do not exist for month selected, please reselect",16,'')
>Endif


The only part of the code that could raise that error is:
oleApp.ActiveWorkbook.SaveAs(m.newfile) && Save the workbook.
That means that MAYBE the folder doesn't exists or labels.xls is opened somewhere else. Put this and give it a try:
........
LOCAL lbError, lcOldError
lcOldError = ON([ERROR])
lbError    = .f.
ON ERROR lbError = .t.
m.newfile=m.dir+"data"
md (m.newfile)
lbError    = .f.
m.newfile=m.newfile+[\labels.xls]
lnHndlr = FOPEN(m.newfile, 12)
lnFor   = 1
DO WHILE lnHndlr < 0
   m.newfile = m.dir + [data\labels]+ALLTRIM(STR(lnFor)) + [.xls]
   lnHndlr   = FOPEN(m.newfile, 12)
   lnFor     = lnFor + 1
ENDDO
FCLOSE(lnHndlr)

ON ERROR &lcOldError

oleApp.ActiveWorkbook.SaveAs(m.newfile)  && Save the workbook.
oleApp.DisplayAlerts = .t.
oleApp.Quit()  &&Quit Excel
oleApp = NULL
MessageBox([Exported file name is: ]+m.newfile)
Wait Clear
Against Stupidity the Gods themselves Contend in Vain - Johann Christoph Friedrich von Schiller
The only thing normal about database guys is their tables.
Previous
Reply
Map
View

Click here to load this message in the networking platform