View Full Version : VARPG - Excel starten
Hallo
hat mal jemand ein Code-Beispiel oder einen Link zum Thema
Staren von Excel und Öffnen einer *.xls-Datei aus einer VARPG-
Anwendung heraus.
Bin für alles dankbar.
Grüße aus 'Regen'sburg
Spoldo
Hallo Spoldo,
du findest ein Beispiel in der VARPG Newsgroup bei Yahoo.
der Link ist
http://de.groups.yahoo.com/group/VARPGDE/
Jeder ist herzlich Willkommen
Gruss
Michael
Hallo
hat mal jemand ein Code-Beispiel oder einen Link zum Thema
Staren von Excel und Öffnen einer *.xls-Datei aus einer VARPG-
Anwendung heraus.
Bin für alles dankbar.
Grüße aus 'Regen'sburg
SpoldoHallo Spoldo,
ich habe ein VARPG-Programm, wo ich das mal gemacht habe.
Wenn Du hier Deine E-Mail-Adresse bekannt gibst, kann ich Dir das Programm schicken.
Gruß
Alexander
Hallo Ihr beiden,
Danke für den Link und das Angebot mir ein Beispiel zu schicken.
meine Email ist in der Signatur.
Nochmals Danke
Hallo Ihr beiden,
Danke für den Link und das Angebot mir ein Beispiel zu schicken.
meine Email ist in der Signatur.
Nochmals Danke
Hallo,
da ich eine Fehlermeldung bekommen, wenn ich Dir meine Source schicken will, stelle ich sie hier ins Forum.
Bevor ich Excel aufrufe, lese ich den Pfad von Excel aus der registry aus, um festzustellen, wo Excel installiert wurde.
Gruß
Alexander
H*EXE
H*MAIN
‚*********************************************** **********************
‚* Programm zur Erstellung der Reklamationsstatistik *
‚* *
‚* Fermum 03.08.2001 *
‚* Das Programm ruft auf der AS/400 das Programm VK0000R auf. *
‚* Dieses Programm erstellt die Datei VKB00000 auf der AS/400. *
‚* Diese Datei wird dann per Knopfdruck in eine lokale Excel-Datei *
‚* kopiert und Excel wird gestartet. *
‚* *
‚*********************************************** ********************** €
fRekStas uf a f 200 disk extfile(#MExcelFile) usropn
fVKB00000 if e disk remote usropn
fDSPMBR if e disk remote usropn
* Prototypes
* DLL Module integrieren ----------------------
D berecht pr 1a DLL('Berechti')
D ExtProc('$BERECHT')
D 10a VALUE
D 10a VALUE
D 1s 0 VALUE
* Berechtigungsmodul Sonderberechtigungen
D berechtu pr 1a DLL('Berechti')
D ExtProc('$BERECHTU')
D 10a VALUE
D 10a VALUE
D 1s 0 VALUE
* löscht eine Datei auf dem lokalen PC
d dltpcfile pr 5i 0 extproc('DeleteFileA')
d dll('Kernel32.dll')
d linkage(*StdCall)
d 255
* API For Opening the Registry and Retrieve Key
D RegOpenKeyEx PR 10I 0 ExtProc('RegOpenKeyExA')
D DLL('advapi32.dll')
D Linkage(*StdCall)
D 10I 0 Value Handle of Open Key
D * Value Options(*String) Name of Key to Open
D 10I 0 Value Unused, set to 0
D 10I 0 Value Which Operation 4 Key
D * Value Return for Key
*
* Retrieve the Keys Value of the Registry
D RegQueryValue PR 10I 0 ExtProc('RegQueryValueExA')
D DLL('advapi32.dll')
D Linkage(*StdCall)
D 10I 0 Value Handle of Open Key
D * Value Options(*String) Name of Value Rtv
D 10I 0 Value Unused 0
D * Value Type of Data Rtv
D * Value Options(*String) Actual Data
D * Value Variable Len
*
* Close the Registry
D RegCloseKey PR 10I 0 ExtProc('RegCloseKey')
D DLL('advapi32.dll')
D Linkage(*StdCall)
D 10I 0 Value Handle of Close Key
d dltpcfile pi 5i 0
*
D* OpenExcel pr cltpgm('wscript.exe +
D* E:\Sourcen\reklasta\RT_WIN32\+
D* StrExl.vbs')
* --------ProgramStatusDS----------
D SDS
D fillersds 1 253
D Buser 254 263
* --------QCMDDDM -----------------
D QCMDDDM C CONST('QCMDDDM')
D LINKAGE(*SERVER)
D CMDTXT S 73A INZ(*blanks )
D CMDLEN S 15 5 INZ(73)
‚*------------------------------------------------------------------
D* Konstanten
‚*------------------------------------------------------------------
* Programm auf der AS/400 erstellt die VKB00000C
D VK0000C C CONST('XBJ/VK0000C')
D LINKAGE(*SERVER)
D #CSchablone C CONST(' . , ')
D #CExcel C 'EXCEL'
d Null c x'00'
* x'09' --> Hex-Code für Tab wird benötigt für *.xls
d #CTab c x'09'
D B_AKTIV C CONST(7) Konstanten für
D B_LOESCHEN C CONST(6) die verschiedenen
D B_ERFASSEN C CONST(5) Programmfunktionen
D B_AENDERN C CONST(4)
D B_DRUCKEN C CONST(3)
D B_STARTEN C CONST(2)
D B_SAENDERN C CONST(1)
d HKEY_LM c x'80000002' Handle
D Key_QueVal c 1
D MessageW c 'MessageW.exe'
D LINKAGE(*client)
D ButtonPc C CONST(1)
D Button400 C CONST(0)
D #CExcelFile c const('RekStas.xls')
‚*------------------------------------------------------------------
‚* interne Variablen
‚*------------------------------------------------------------------
* für Registry-APIs
D RetV S 10I 0 Return Value
D hKey S 10U 0 Key Value
D KeyName S 255A Inz(*blanks) Registry Directory
D Type s 10I 0 Data Type
D Direct S 255 Inz(*Blanks) Actual Data
D Len S 10I 0 Inz(255) Data Length
*
D #MExcelFile s 255
d #HFeld s 255 varying
d #MExcel s 255 linkage(*client)
d apirc s 5i 0
d #MIPValueName s 255 inz('SOFTWARE\Microsoft\Office\+
d 9.0\Excel\InstallRoot\')
d Zaehler s 10 0 inz(*zeros)
d AnZaehler s 10 inz(*blanks)
d AnHoehe s 3
d AnBreite s 3
d AnMeter s 5
d AnNetto s 9
d UeberSatz s 200
d DelFeld s 200
d #HDateIso s d datfmt(*iso)
d #HDateTxt s 10
d Zeit s 6 0
d Zeit4 s 4 0
d #VDatum s 6 0
d #BDatum s 6 0
d #VDatum8 s 8 0
d #BDatum8 s 8 0
d #VDatum8An s 8
d #BDatum8An s 8
d #VDatumError s 1
d #BDatumError s 1
d Tage s 2 0
* für Programmcall Berechtigungen
d user s 10
d prog s 10
d funktion s 1 0
d berechtigung s 1
d return s 10i 0
d #HMsg s 7
d #PAnMs1 s 30 inz('*blanks')
d #PAnMs2 s 30 inz('*blanks')
d #PAnMs3 s 30 inz('*blanks')
d #PAnMs4 s 30 inz('*blanks')
d #PAnMs5 s 30 inz('*blanks')
D DsNamePass ds
D #PUserId 10
D #PPassWord 10
‚*------------------------------------------------------------------
‚* Eigabebestimmungen
‚*------------------------------------------------------------------
IRekStas kf
I 1 200 EinFeld
‚*------------------------------------------------------------------
‚* Rechenbestimmungen
‚*------------------------------------------------------------------
************************************************** *******************
*
* Window . . : WINDOW1
*
* Part . . . : STRBUTTON
*
* Event . . : PRESS
*
* Description:
*
************************************************** *******************
*
C STRBUTTON BEGACT PRESS WINDOW1
c eval prog = 'REKSTAS'
c select
c
c when BERECHTU(#PUserId:prog:Button400) = *off
c eval %setatr('window1':'StatusBar':'Visible') = 1
c eval %setatr('window1':'StatusBar':'SbLabel') =
c 'Keine Berechtigung für diese Auswahl!'
c
c other
c eval #VDatum = %getatr('window1':'VonDatum':
c 'Text')
c eval #BDatum = %getatr('window1':'BisDatum':
c 'Text')
*** Prüfung der eingegebenen Daten
c *dmy test(de) #VDatum
c if %error
c eval #VDatumError = *on
c else
c eval #VDatumError = *off
c *dmy move #VDatum #HDateIso
c *iso move #HDateIso #VDatum8
c endif
c *dmy test(de) #BDatum
c
c if %error
c eval #BDatumError = *on
c else
c eval #BDatumError = *off
c *dmy move #BDatum #HDateIso
c *iso move #HDateIso #BDatum8
c endif
*
c select
*
c when #VDatumError = *on
c eval %setatr('window1':'StatusBar':'Visible') = 1
c eval %setatr('window1':'StatusBar':'SbLabel') =
c 'VonDatum ist ungültig'
*
c when #BDatumError = *on
c eval %setatr('window1':'StatusBar':'Visible') = 1
c eval %setatr('window1':'StatusBar':'SbLabel') =
c 'BisDatum ist ungültig'
*
c when #VDatum8 > #BDatum8
c eval %setatr('window1':'StatusBar':'Visible') = 1
c eval %setatr('window1':'StatusBar':'SbLabel') =
c 'VonDatum ist grösser als BisDatum'
*
c other
c eval %setatr('window1':'StatusBar':'Visible') = 1
c eval %setatr('window1':'StatusBar':'SbLabel') =
c 'Bitte warten, Verarbeitung läuft...'
*
c exsr RunAs400
*
c endsl
*
c endsl
*
C ENDACT
************************************************** *******************
*
* Window . . : WINDOW1
*
* Part . . . : EXITBUTTON
*
* Event . . : PRESS
*
* Description:
*
************************************************** *******************
*
C EXITBUTTON BEGACT PRESS WINDOW1
* Löschen der temporären PC-Datei
c eval #MExcelFile=%trim(#MExcelFile)+Null
c eval apirc=dltpcfile(#MExcelFile)
c eval *inlr = *on
*
C ENDACT
************************************************** *******************
*
* Window . . : WINDOW1
*
* Part . . . : CAN000000A
*
* Event . . : CREATE
*
* Description:
*
************************************************** *******************
*
C CAN000000A BEGACT CREATE WINDOW1
*
C start 'Signon' 99
C parm return
C ENDACT
************************************************** *******************
*
* Window . . : WINDOW1
*
* Part . . . : EXCELSTART
*
* Event . . : PRESS
*
* Description: Startet Excel mit der Datei RekStas.xls
*
************************************************** *******************
*
C EXCELSTART BEGACT PRESS WINDOW1
*
c eval #MExcelFile=%trim(#MExcelFile)+Null
c eval apirc=dltpcfile(#MExcelFile)
*
s1 c if not %open(VKB00000)
c open(e) vkb00000
s2 c if %error
c eval #HMsg = 'VAR0002'
c eval #PAnMs1 = 'VKB00000'
c start MessageW
c parm #HMsg
c parm #PAnMs1
c parm #PAnMs2
c parm #PAnMs3
c parm #PAnMs4
c parm #PAnMs5
c parm #PUserId
c parm #PPassWord
x2 c else
c
s3 c if not %open(RekStas)
c open(e) RekStas
s4 c if %error
c close VKB00000
c eval #HMsg = 'VAR0001'
c eval #PAnMs1 = #CExcelFile
c start MessageW
c parm #HMsg
c parm #PAnMs1
c parm #PAnMs2
c parm #PAnMs3
c parm #PAnMs4
c parm #PAnMs5
c parm #PUserId
c parm #PPassWord
x4 c else
c
*
c eval prog = 'REKSTAS'
c eval user = #PUserId
c
s5 c select
c
x5 c when BERECHTU(USER:prog:ButtonPc) = *off
c eval %setatr('window1':'StatusBar':'Visible') = 1
c eval %setatr('window1':'StatusBar':'SbLabel') =
c 'Keine Berechtigung für diese Auswahl!'
c
x5 c other
c
*
c read vkb000
c eval Uebersatz= 'Kunden Nr.' + #CTab +
c 'Artikel' + #CTab +
c 'Dessin 1' + #CTab +
c 'Dessin' + #CTab +
c 'Hoehe' + #CTab +
c 'Breite' + #CTab +
c 'Meter' + #CTab +
c 'Gutschr.Key' + #CTab +
c 'Gutschritfstext' + #CTab +
c 'Positionstext' + #CTab +
c 'Netto Betrag' + #CTab +
c 'Eingangsdatum' + #CTab +
c 'Gutschriftsnummer' + #CTab +
c 'Eingangsnummer' + #CTab
c except UeberSchri
*
s6 c dow not %eof(VKB00000)
*
s7 c if RELTXTPOSI = '"'
c eval RELTXTPOSI = '""'
e7 c endif
*
c eval RELNETTOW = RELNETTOW * (-1)
c eval AnHoehe = %trim(%editw(RELHoehe :
c #CSchablone))
c eval AnBreite= %trim(%editw(RELBreite :
c #CSchablone))
c eval AnMeter = %trim(%editw(RELMeter :
c #CSchablone))
c eval AnNetto = %trim(%editw(RELNETTOW :
c #CSchablone))
c except satz
c read VKB00000
e6 c enddo
*
c close RekStas
c close vkb00000
c*** callp OpenExcel
*
c start #MExcel
c parm #MExcelFile
*
e5 c endsl
*
e4 c endif
e3 c endif
*
s2 c endif
e1 c endif
*
C ENDACT
************************************************** *******************
*
* Fenster . . : WINDOW1
*
* Komponente : TIMER
*
* Ereignis . : TICK
*
* Beschreibung:
*
************************************************** *******************
*
C TIMER BEGACT TICK WINDOW1
C exsr Get_Time
*
C ENDACT
************************************************** *******************
c Get_Time begsr
*
C time Zeit
C movel Zeit Zeit4
c eval %setatr('window1':'UhrZeit':'Text')= Zeit4
*
c endsr
************************************************** *******************
c RunAs400 begsr
*
c* call VK0000C
c* parm AnZaehler
* Aufruf des Programms auf der AS400 mit QCMDDDM, damit die Datei in der QTEMP
* erzeugt und verarbeitet werden kann
c move #VDatum8 #VDatum8An
c move #BDatum8 #BDatum8An
c eval cmdtxt ='CALL PGM(VK0000C) PARM(' +
c '''' + #VDatum8An + '''' + ' ' +
c '''' + #BDatum8An + ''')'
c call QCMDDDM
c parm CMDTXT
c parm CMDLEN
*
c if not %open(DSPMBR)
c open DSPMBR
c read QWHFDMBR
c if not %eof(DSPMBR)
c move MBNRCD AnZaehler
c endif
c close DSPMBR
c endif
*
c move AnZaehler Zaehler
c eval %setatr('window1':'Feld1':'Text') = Zaehler
c eval %setatr('window1':'StatusBar':'Visible') = 0
*
c endsr
************************************************** *******************
************************************************** *******************
*
* Fenster . . : WINDOW1
*
* Komponente : CRF1
*
* Ereignis . : NOTIFY
*
* Beschreibung:
*
************************************************** *******************
*
C CRF1 BEGACT NOTIFY WINDOW1
* Overwrite Database-File KRB00000, auf Datei in QTEMP
c eval cmdtxt ='OVRDBF FILE(VKB00000) +
c TOFILE(QTEMP/VKB00000) OVRSCOPE(*JOB)'
c call QCMDDDM
c parm CMDTXT
c parm CMDLEN
* Overwrite Database-File DSPMBR, auf Datei DSPMBR in QTEMP
c eval cmdtxt ='OVRDBF FILE(DSPMBR) +
c TOFILE(QTEMP/DSPMBR) OVRSCOPE(*JOB)'
c call QCMDDDM
c parm CMDTXT
c parm CMDLEN
*
C eval %setatr('*component':'*component':
C 'ShDataName')='NamePass'
C eval DsNamePass=%getatr('*component':
C '*component':'ShData')
*
c** if not %open(vkb00000)
c** open vkb00000
c** endif
*
c eval prog = 'REKSTAS'
* schliessen der AS400-Datei, da sie sonst auf der AS400 blockiert ist
c close VKB00000
c if BERECHT(#PUserId:prog:B_STARTEN) = *off
*
c eval #HMsg = 'VAR0000'
c eval #PAnMs1 = #PUserId
c eval #PAnMs2 = prog
c start MessageW
c parm #HMsg
c parm #PAnMs1
c parm #PAnMs2
c parm #PAnMs3
c parm #PAnMs4
c parm #PAnMs5
c parm #PUserId
c parm #PPassWord
*
c eval *inlr = *on
c endif
*
* Retrieve the Key for the Registry
C eval KeyName=%TrimR(#MIPValueName) + Null
C eval RetV=RegOpenKeyEx(HKEY_LM:%ADDR(KeyName)
C :0:Key_QueVal:%ADDR(hKey))
*
* If no Error found Retrieve the Path String
C If RetV = 0
C Eval KeyName='Path' + Null
C eval RetV=RegQueryValue(hkey:%ADDR(KeyName):
C 0:%ADDR(Type):%ADDR(Direct):
C %ADDR(Len))
C EndIf
*
C If RetV = 0
C eval len = len - 1
C eval #MExcel = %subst(Direct:1:len) + #CExcel
C eval #MExcelfile =%subst(Direct:1:len)+#CExcelfile
*
* Pass the Key of Registry and Close It
C Eval Retv=RegCloseKey(hkey)
C EndIf
*
c time #HDateIso
c *eur move #HDateIso #HDateTxt
c eval %setatr('window1':'Datum':'Text') =#HDateTxt
c extrct #HDateIso:*D Tage
c #HDateIso subdur tage:*days #HDateIso
c *dmy move #HDateIso #BDatum
c eval %setatr('window1':'BisDatum':'Text') =
c #BDatum
c extrct #HDateIso:*D Tage
c eval Tage = Tage - 1
c #HDateIso subdur tage:*days #HDateIso
c *dmy move #HDateIso #VDatum
c eval %setatr('window1':'VonDatum':'Text') =
c #VDatum
*
c exsr Get_Time
c eval %setatr('window1':'StatusBar':'Visible') = 0
*
c if RetV <> 0
c eval %setatr('window1':'StatusBar':'Visible') = 1
c eval %setatr('window1':'StatusBar':'SbLabel') =
c 'Fehler bei Ermittlung des Excel-Pfades! ' +
c 'Bitte an die EDV wenden.'
c endif
*
C stop 'signon'
*
C ENDACT
* Ausgabebestimmungen für die lokale Excel-Datei
oRekStas eadd Satz
o RELKUNDE
o #CTab
o RELARTIKEL
o #CTab
o RELDESSIN1
o #CTab
o RELDESSIN
o #CTab
o AnHOEHE
o #CTab
o AnBREITE
o #CTab
o AnMETER
o #CTab
o RELGUTKEY
o #CTab
o RELTXTGUTS
o #CTab
o RELTXTPOSI
o #CTab
o AnNetto
o #CTab
o RELEINDAT
o #CTab
o RELGNR
o #CTab
o RELEINNR
oRekStas eadd Ueberschri
o UeberSatz
Danke,
da hab ich ja mal was zu tun.
Ich nehme mal an, unser doofer Mailserver macht wieder Probleme. Danke trotzdem für Deine Bemühungen.