Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
That doesn't happen on MY machine
Message
De
21/12/2006 15:38:32
 
 
À
21/12/2006 15:27:19
Information générale
Forum:
Visual FoxPro
Catégorie:
COM/DCOM et OLE Automation
Versions des environnements
Visual FoxPro:
VFP 6 SP3
OS:
Windows XP SP2
Database:
Visual FoxPro
Divers
Thread ID:
01179645
Message ID:
01179670
Vues:
12
>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.
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform