officefunkt.p 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720
  1. &ANALYZE-SUSPEND _VERSION-NUMBER UIB_v9r12
  2. &ANALYZE-RESUME
  3. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
  4. /*------------------------------------------------------------------------
  5. File :
  6. Purpose :
  7. Syntax :
  8. Description :
  9. Author(s) :
  10. Created :
  11. Notes :
  12. ----------------------------------------------------------------------*/
  13. /* This .W file was created with the Progress AppBuilder. */
  14. /*----------------------------------------------------------------------*/
  15. /* ---------- Globale Variablen ---------------------------------- */
  16. /* _UIB-CODE-BLOCK-END */
  17. &ANALYZE-RESUME
  18. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  19. /* ******************** Preprocessor Definitions ******************** */
  20. &Scoped-define PROCEDURE-TYPE Procedure
  21. &Scoped-define DB-AWARE no
  22. /* _UIB-PREPROCESSOR-BLOCK-END */
  23. &ANALYZE-RESUME
  24. /* ************************ Function Prototypes ********************** */
  25. &IF DEFINED(EXCLUDE-CREATEEXCEL) = 0 &THEN
  26. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD CREATEEXCEL Procedure
  27. FUNCTION CREATEEXCEL RETURNS COMPONENT-HANDLE
  28. ( /* parameter-definitions */ ) FORWARD.
  29. /* _UIB-CODE-BLOCK-END */
  30. &ANALYZE-RESUME
  31. &ENDIF
  32. &IF DEFINED(EXCLUDE-CREATEWORD) = 0 &THEN
  33. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD CREATEWORD Procedure
  34. FUNCTION CREATEWORD RETURNS COMPONENT-HANDLE
  35. ( /* parameter-definitions */ ) FORWARD.
  36. /* _UIB-CODE-BLOCK-END */
  37. &ANALYZE-RESUME
  38. &ENDIF
  39. &IF DEFINED(EXCLUDE-RELEASEEXCEL) = 0 &THEN
  40. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD RELEASEEXCEL Procedure
  41. FUNCTION RELEASEEXCEL RETURNS CHARACTER
  42. ( excelAppl AS COMPONENT-HANDLE ) FORWARD.
  43. /* _UIB-CODE-BLOCK-END */
  44. &ANALYZE-RESUME
  45. &ENDIF
  46. &IF DEFINED(EXCLUDE-RELEASEWORD) = 0 &THEN
  47. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD RELEASEWORD Procedure
  48. FUNCTION RELEASEWORD RETURNS CHARACTER
  49. ( wordAppl AS COMPONENT-HANDLE ) FORWARD.
  50. /* _UIB-CODE-BLOCK-END */
  51. &ANALYZE-RESUME
  52. &ENDIF
  53. /* *********************** Procedure Settings ************************ */
  54. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  55. /* Settings for THIS-PROCEDURE
  56. Type: Procedure
  57. Allow:
  58. Frames: 0
  59. Add Fields to: Neither
  60. Other Settings: CODE-ONLY COMPILE
  61. */
  62. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  63. /* ************************* Create Window ************************** */
  64. &ANALYZE-SUSPEND _CREATE-WINDOW
  65. /* DESIGN Window definition (used by the UIB)
  66. CREATE WINDOW Procedure ASSIGN
  67. HEIGHT = 15
  68. WIDTH = 60.
  69. /* END WINDOW DEFINITION */
  70. */
  71. &ANALYZE-RESUME
  72. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  73. /* *************************** Main Block *************************** */
  74. PROCEDURE ShellExecuteA EXTERNAL "shell32.dll":
  75. DEFINE INPUT PARAMETER hwnd AS LONG. /* Handle to parent window */
  76. DEFINE INPUT PARAMETER lpOperation AS CHARACTER. /* Operation to perform: open, print */
  77. DEFINE INPUT PARAMETER lpFile AS CHARACTER. /* Document or executable name */
  78. DEFINE INPUT PARAMETER lpParameters AS CHARACTER. /* Command line parameters to executable in lpFile */
  79. DEFINE INPUT PARAMETER lpDirectory AS CHARACTER. /* Default directory */
  80. DEFINE INPUT PARAMETER nShowCmd AS LONG. /* whether shown when opened:
  81. 0 hidden, 1 normal, minimized 2, maximized 3,
  82. 0 if lpFile is a document */
  83. DEFINE RETURN PARAMETER hInstance AS LONG. /* Less than or equal to 32 */
  84. END PROCEDURE.
  85. /* _UIB-CODE-BLOCK-END */
  86. &ANALYZE-RESUME
  87. /* ********************** Internal Procedures *********************** */
  88. &IF DEFINED(EXCLUDE-CREATEDATEI) = 0 &THEN
  89. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE CREATEDATEI Procedure
  90. PROCEDURE CREATEDATEI :
  91. /*------------------------------------------------------------------------------
  92. Purpose:
  93. Parameters: <none>
  94. Notes:
  95. ------------------------------------------------------------------------------*/
  96. /*
  97. Parameter 1 = DateiName
  98. 2 = Vorlage
  99. 3 = Pfad der Datei
  100. */
  101. DEFINE INPUT PARAMETER ipParam AS CHARACTER NO-UNDO.
  102. DEFINE VARIABLE DateiName AS CHARACTER NO-UNDO.
  103. DEFINE VARIABLE Vorlage AS CHARACTER NO-UNDO.
  104. DEFINE VARIABLE Pfad AS CHARACTER NO-UNDO.
  105. DEFINE VARIABLE Laenge AS INTEGER NO-UNDO.
  106. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  107. DEFINE VARIABLE ix AS INTEGER NO-UNDO.
  108. DEFINE VARIABLE Ja AS LOG NO-UNDO.
  109. DateiName = ''.
  110. Vorlage = ''.
  111. Pfad = ''.
  112. IF NUM-ENTRIES(ipParam, CHR(01)) = 0 THEN RETURN 'ERROR-PARAMETER'.
  113. IF NUM-ENTRIES(ipParam, CHR(01)) > 0 THEN DateiName = ENTRY(1, ipParam, CHR(01)).
  114. IF NUM-ENTRIES(ipParam, CHR(01)) > 1 THEN Vorlage = ENTRY(2, ipParam, CHR(01)).
  115. IF NUM-ENTRIES(ipParam, CHR(01)) > 2 THEN Pfad = ENTRY(3, ipParam, CHR(01)).
  116. IF DateiName = '' THEN RETURN 'ERROR-PARAMETER'.
  117. IF Pfad = '' THEN
  118. DO:
  119. Pfad = SESSION:TEMP-DIR.
  120. END.
  121. Laenge = LENGTH(Pfad).
  122. DO WHILE TRUE:
  123. IF SUBSTRING(Pfad,Laenge,01) = '/' THEN LEAVE.
  124. IF SUBSTRING(Pfad,Laenge,01) = '\' THEN LEAVE.
  125. Pfad = Pfad + '\'.
  126. LEAVE.
  127. END.
  128. DateiName = Pfad + DateiName.
  129. DO WHILE TRUE:
  130. IF SEARCH(DateiName) = ? THEN LEAVE.
  131. FILE-INFO:FILE-NAME = DateiName.
  132. DateiName = FILE-INFO:FULL-PATHNAME.
  133. ERROR-STATUS:ERROR = FALSE.
  134. OS-DELETE VALUE(DateiName) NO-ERROR.
  135. IF ERROR-STATUS:ERROR THEN
  136. DO:
  137. Ja = TRUE.
  138. MESSAGE 'Datei ' DateiName ' ist im Zugriff ' SKIP
  139. 'und kann nicht gelöscht werden ! '
  140. VIEW-AS ALERT-BOX INFORMATION BUTTONS RETRY-CANCEL
  141. UPDATE Ja.
  142. IF Ja THEN NEXT.
  143. RETURN 'ERROR-LOESCHEN'.
  144. END.
  145. LEAVE.
  146. END.
  147. DO WHILE TRUE:
  148. IF Vorlage = '' THEN LEAVE.
  149. IF SEARCH(Vorlage) <> ? THEN
  150. DO:
  151. Vorlage = SEARCH(Vorlage).
  152. FILE-INFO:FILE-NAME = Vorlage.
  153. Vorlage = FILE-INFO:FULL-PATHNAME.
  154. LEAVE.
  155. END.
  156. cString = ''.
  157. Laenge = LENGTH(Vorlage).
  158. DO ix = Laenge TO 1 BY -1:
  159. IF SUBSTRING(Vorlage,ix,01) = '/' THEN LEAVE.
  160. IF SUBSTRING(Vorlage,ix,01) = '\' THEN LEAVE.
  161. cString = SUBSTRING(Vorlage,ix,01) + cString.
  162. END.
  163. Vorlage = 'Vorlagen\' + cString.
  164. IF SEARCH(Vorlage) <> ? THEN
  165. DO:
  166. Vorlage = SEARCH(Vorlage).
  167. FILE-INFO:FILE-NAME = Vorlage.
  168. Vorlage = FILE-INFO:FULL-PATHNAME.
  169. LEAVE.
  170. END.
  171. Vorlage = 'WordVorlagen\' + cString.
  172. IF SEARCH(Vorlage) <> ? THEN
  173. DO:
  174. Vorlage = SEARCH(Vorlage).
  175. FILE-INFO:FILE-NAME = Vorlage.
  176. Vorlage = FILE-INFO:FULL-PATHNAME.
  177. LEAVE.
  178. END.
  179. Vorlage = 'ExcelVorlagen\' + cString.
  180. IF SEARCH(Vorlage) <> ? THEN
  181. DO:
  182. Vorlage = SEARCH(Vorlage).
  183. FILE-INFO:FILE-NAME = Vorlage.
  184. Vorlage = FILE-INFO:FULL-PATHNAME.
  185. LEAVE.
  186. END.
  187. RETURN 'ERROR-VORLAGE'.
  188. END.
  189. IF Vorlage <> '' THEN OS-COPY VALUE(Vorlage) VALUE(DateiName).
  190. ELSE
  191. DO:
  192. OUTPUT TO VALUE(DateiName).
  193. OUTPUT CLOSE.
  194. END.
  195. RETURN DateiName.
  196. END PROCEDURE.
  197. /* _UIB-CODE-BLOCK-END */
  198. &ANALYZE-RESUME
  199. &ENDIF
  200. &IF DEFINED(EXCLUDE-OPENEXCEL) = 0 &THEN
  201. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE OPENEXCEL Procedure
  202. PROCEDURE OPENEXCEL :
  203. /*------------------------------------------------------------------------------
  204. Purpose:
  205. Parameters: <none>
  206. Notes:
  207. ------------------------------------------------------------------------------*/
  208. DEFINE INPUT PARAMETER excelAppl AS COMPONENT-HANDLE NO-UNDO.
  209. DEFINE INPUT PARAMETER VDateiName AS CHARACTER NO-UNDO.
  210. DEFINE INPUT PARAMETER VMakro AS CHARACTER NO-UNDO.
  211. DEFINE OUTPUT PARAMETER io AS LOG NO-UNDO.
  212. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  213. DEFINE VARIABLE Laenge AS INTEGER NO-UNDO.
  214. DEFINE VARIABLE ix AS INTEGER NO-UNDO.
  215. DEFINE VARIABLE ReadOnly AS LOG NO-UNDO.
  216. DO WHILE TRUE:
  217. IF VDateiName = '' THEN
  218. DO:
  219. io = FALSE.
  220. RETURN.
  221. END.
  222. IF SEARCH(VDateiName) <> ? THEN
  223. DO:
  224. VDateiName = SEARCH(VDateiName).
  225. LEAVE.
  226. END.
  227. cString = ''.
  228. Laenge = LENGTH(VDateiName).
  229. DO ix = Laenge TO 1 BY -1:
  230. IF SUBSTRING(VDateiName,ix,01) = '/' THEN LEAVE.
  231. IF SUBSTRING(VDateiName,ix,01) = '\' THEN LEAVE.
  232. cString = SUBSTRING(VDateiName,ix,01) + cString.
  233. END.
  234. VDateiName = 'Vorlagen\' + cString.
  235. IF SEARCH(VDateiName) <> ? THEN
  236. DO:
  237. VDateiName = SEARCH(VDateiName).
  238. LEAVE.
  239. END.
  240. VDateiName = 'WordVorlagen\' + cString.
  241. IF SEARCH(VDateiName) <> ? THEN
  242. DO:
  243. VDateiName = SEARCH(VDateiName).
  244. LEAVE.
  245. END.
  246. VDateiName = 'ExcelVorlagen\' + cString.
  247. IF SEARCH(VDateiName) <> ? THEN
  248. DO:
  249. VDateiName = SEARCH(VDateiName).
  250. LEAVE.
  251. END.
  252. io = FALSE.
  253. RETURN.
  254. END.
  255. FILE-INFO:FILE-NAME = VDateiName.
  256. VDateiName = FILE-INFO:FULL-PATHNAME.
  257. IF INDEX(VDateiName, 'Vorlage') > 0 THEN ReadOnly = TRUE.
  258. ELSE ReadOnly = FALSE.
  259. io = excelAppl:Workbooks:Open(VDateiName, 0, ReadOnly) NO-ERROR.
  260. IF NOT io THEN RETURN.
  261. IF VMakro = '' THEN RETURN.
  262. io = excelAppl:APPLICATION:RUN(VMakro).
  263. RETURN.
  264. END PROCEDURE.
  265. /* _UIB-CODE-BLOCK-END */
  266. &ANALYZE-RESUME
  267. &ENDIF
  268. &IF DEFINED(EXCLUDE-OPENWORD) = 0 &THEN
  269. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE OPENWORD Procedure
  270. PROCEDURE OPENWORD :
  271. /*------------------------------------------------------------------------------
  272. Purpose:
  273. Parameters: <none>
  274. Notes:
  275. ------------------------------------------------------------------------------*/
  276. DEFINE INPUT PARAMETER wordAppl AS COMPONENT-HANDLE NO-UNDO.
  277. DEFINE INPUT PARAMETER VDateiName AS CHARACTER NO-UNDO.
  278. DEFINE INPUT PARAMETER VMakro AS CHARACTER NO-UNDO.
  279. DEFINE OUTPUT PARAMETER io AS LOG NO-UNDO.
  280. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  281. DEFINE VARIABLE Laenge AS INTEGER NO-UNDO.
  282. DEFINE VARIABLE ix AS INTEGER NO-UNDO.
  283. DEFINE VARIABLE ReadOnly AS LOG NO-UNDO.
  284. DO WHILE TRUE:
  285. IF VDateiName = '' THEN
  286. DO:
  287. io = FALSE.
  288. RETURN.
  289. END.
  290. IF SEARCH(VDateiName) <> ? THEN
  291. DO:
  292. VDateiName = SEARCH(VDateiName).
  293. LEAVE.
  294. END.
  295. cString = ''.
  296. Laenge = LENGTH(VDateiName).
  297. DO ix = Laenge TO 1 BY -1:
  298. IF SUBSTRING(VDateiName,ix,01) = '/' THEN LEAVE.
  299. IF SUBSTRING(VDateiName,ix,01) = '\' THEN LEAVE.
  300. cString = SUBSTRING(VDateiName,ix,01) + cString.
  301. END.
  302. VDateiName = 'Vorlagen\' + cString.
  303. IF SEARCH(VDateiName) <> ? THEN
  304. DO:
  305. VDateiName = SEARCH(VDateiName).
  306. LEAVE.
  307. END.
  308. VDateiName = 'WordVorlagen\' + cString.
  309. IF SEARCH(VDateiName) <> ? THEN
  310. DO:
  311. VDateiName = SEARCH(VDateiName).
  312. LEAVE.
  313. END.
  314. VDateiName = 'ExcelVorlagen\' + cString.
  315. IF SEARCH(VDateiName) <> ? THEN
  316. DO:
  317. VDateiName = SEARCH(VDateiName).
  318. LEAVE.
  319. END.
  320. io = FALSE.
  321. RETURN.
  322. END.
  323. FILE-INFO:FILE-NAME = VDateiName.
  324. VDateiName = FILE-INFO:FULL-PATHNAME.
  325. IF INDEX(VDateiName, 'Vorlage') > 0 THEN ReadOnly = TRUE.
  326. ELSE ReadOnly = FALSE.
  327. io = wordAppl:Documents:Open(VDateiName, 0, ReadOnly) NO-ERROR.
  328. IF NOT io THEN RETURN.
  329. IF VMakro = '' THEN RETURN.
  330. io = wordAppl:APPLICATION:RUN(VMakro).
  331. RETURN.
  332. END PROCEDURE.
  333. /* _UIB-CODE-BLOCK-END */
  334. &ANALYZE-RESUME
  335. &ENDIF
  336. &IF DEFINED(EXCLUDE-SEND_MAIL) = 0 &THEN
  337. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SEND_MAIL Procedure
  338. PROCEDURE SEND_MAIL :
  339. /*------------------------------------------------------------------------------
  340. Purpose:
  341. Parameters: <none>
  342. Notes:
  343. ------------------------------------------------------------------------------*/
  344. DEFINE INPUT PARAMETER ipFirma AS CHARACTER NO-UNDO.
  345. DEFINE INPUT PARAMETER ipKnr AS INTEGER NO-UNDO.
  346. DEFINE INPUT PARAMETER ipSubject AS CHARACTER NO-UNDO.
  347. DEFINE INPUT PARAMETER ipText AS CHARACTER NO-UNDO.
  348. DEFINE INPUT PARAMETER ipAttach AS CHARACTER NO-UNDO.
  349. DEFINE VARIABLE cMail AS CHARACTER NO-UNDO.
  350. DEFINE VARIABLE lSuccess AS LOG NO-UNDO INIT FALSE .
  351. DEFINE VARIABLE objOLApp AS COMPONENT-HANDLE NO-UNDO.
  352. DEFINE VARIABLE objOLMail AS COMPONENT-HANDLE NO-UNDO.
  353. DEFINE VARIABLE objOLAttach AS COMPONENT-HANDLE NO-UNDO.
  354. DEFINE VARIABLE objOLFiles AS COMPONENT-HANDLE NO-UNDO.
  355. cMail = (IF INDEX(ipFirma, '@') = 0 THEN '' ELSE ipFirma).
  356. DO WHILE TRUE:
  357. IF cMail <> '' THEN LEAVE.
  358. FIND Adresse USE-INDEX Adresse-k1
  359. WHERE Adresse.Firma = ipFirma
  360. AND Adresse.Knr = ipKnr NO-LOCK NO-ERROR.
  361. IF Adresse.Mail = '' THEN LEAVE.
  362. IF INDEX(Adresse.Mail, '@') = 0 THEN LEAVE.
  363. cMail = Adresse.Mail.
  364. LEAVE.
  365. END.
  366. IF cMail = '' THEN RETURN NO-APPLY.
  367. DO WHILE TRUE:
  368. CREATE 'Outlook.Application' objOLApp CONNECT NO-ERROR.
  369. IF VALID-HANDLE(objOLApp) THEN LEAVE.
  370. CREATE 'Outlook.Application' objOLApp NO-ERROR.
  371. LEAVE.
  372. END.
  373. IF NOT VALID-HANDLE(objOLApp) THEN
  374. DO:
  375. MESSAGE 'Mail ist nicht installiert' VIEW-AS ALERT-BOX ERROR.
  376. RETURN NO-APPLY.
  377. END.
  378. objOLMail = objOLApp:CreateItem(0).
  379. IF NOT VALID-HANDLE(objOLMail) THEN
  380. DO:
  381. MESSAGE 'Kann kein neues Mail erfassen' VIEW-AS ALERT-BOX.
  382. RETURN NO-APPLY.
  383. END.
  384. objOLMail:To = cMail.
  385. objOLMail:Body = ipText + CHR(10).
  386. IF ipAttach <> '' THEN
  387. DO:
  388. objOLAttach = objOLMail:Attachments:Add(ipAttach, 1 ) NO-ERROR.
  389. /*
  390. objOLAttach:NAME = 'Hallo'.
  391. chFiles:source = ENTRY(iLoop, cFiles).
  392. */
  393. END.
  394. objOLMail:Subject = ipSubject.
  395. objOLMail:Display.
  396. /*
  397. objOLMail:Send.
  398. */
  399. IF VALID-HANDLE(objOLAttach) THEN RELEASE OBJECT objOLAttach.
  400. IF VALID-HANDLE(objOLMail ) THEN RELEASE OBJECT objOLMail.
  401. IF VALID-HANDLE(objOLApp ) THEN RELEASE OBJECT objOLApp.
  402. lSuccess = TRUE.
  403. END PROCEDURE.
  404. /* _UIB-CODE-BLOCK-END */
  405. &ANALYZE-RESUME
  406. &ENDIF
  407. &IF DEFINED(EXCLUDE-SEND_MAIL_BY_MAILADRESSE) = 0 &THEN
  408. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SEND_MAIL_BY_MAILADRESSE Procedure
  409. PROCEDURE SEND_MAIL_BY_MAILADRESSE :
  410. /*------------------------------------------------------------------------------
  411. Purpose:
  412. Parameters: <none>
  413. Notes:
  414. ------------------------------------------------------------------------------*/
  415. DEFINE INPUT PARAMETER ipSendTo AS CHARACTER NO-UNDO.
  416. DEFINE INPUT PARAMETER ipCC AS CHARACTER NO-UNDO.
  417. DEFINE INPUT PARAMETER ipSubject AS CHARACTER NO-UNDO.
  418. DEFINE INPUT PARAMETER ipText AS CHARACTER NO-UNDO.
  419. DEFINE INPUT PARAMETER ipAttach AS CHARACTER NO-UNDO.
  420. DEFINE VARIABLE lSuccess AS LOG NO-UNDO INIT FALSE .
  421. DEFINE VARIABLE objOLApp AS COMPONENT-HANDLE NO-UNDO.
  422. DEFINE VARIABLE objOLMail AS COMPONENT-HANDLE NO-UNDO.
  423. DEFINE VARIABLE objOLAttach AS COMPONENT-HANDLE NO-UNDO.
  424. DEFINE VARIABLE objOLFiles AS COMPONENT-HANDLE NO-UNDO.
  425. IF ipSendTo = '' THEN RETURN NO-APPLY.
  426. DO WHILE TRUE:
  427. CREATE 'Outlook.Application' objOLApp CONNECT NO-ERROR.
  428. IF VALID-HANDLE(objOLApp) THEN LEAVE.
  429. CREATE 'Outlook.Application' objOLApp NO-ERROR.
  430. LEAVE.
  431. END.
  432. IF NOT VALID-HANDLE(objOLApp) THEN
  433. DO:
  434. MESSAGE 'Mail ist nicht installiert' VIEW-AS ALERT-BOX ERROR.
  435. RETURN NO-APPLY.
  436. END.
  437. objOLMail = objOLApp:CreateItem(0).
  438. IF NOT VALID-HANDLE(objOLMail) THEN
  439. DO:
  440. MESSAGE 'Kann kein neues Mail erfassen' VIEW-AS ALERT-BOX.
  441. RETURN NO-APPLY.
  442. END.
  443. objOLAttach = objOLMail:Attachments.
  444. objOLMail:To = ipSendTo.
  445. objOLMail:BCC = ipCC.
  446. objOLMail:Body = ipText + CHR(10) + CHR(10).
  447. IF ipAttach <> '' THEN
  448. DO:
  449. objOLAttach = objOLAttach:Add(ipAttach) NO-ERROR.
  450. END.
  451. objOLMail:Subject = ipSubject.
  452. objOLMail:Display.
  453. IF ipText <> '' THEN objOLMail:Send.
  454. IF VALID-HANDLE(objOLAttach) THEN RELEASE OBJECT objOLAttach.
  455. IF VALID-HANDLE(objOLMail ) THEN RELEASE OBJECT objOLMail.
  456. IF VALID-HANDLE(objOLApp ) THEN RELEASE OBJECT objOLApp.
  457. lSuccess = TRUE.
  458. END PROCEDURE.
  459. /* _UIB-CODE-BLOCK-END */
  460. &ANALYZE-RESUME
  461. &ENDIF
  462. &IF DEFINED(EXCLUDE-ZELLEFUELLEN) = 0 &THEN
  463. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ZELLEFUELLEN Procedure
  464. PROCEDURE ZELLEFUELLEN :
  465. /*------------------------------------------------------------------------------
  466. Purpose:
  467. Parameters: <none>
  468. Notes:
  469. ------------------------------------------------------------------------------*/
  470. DEFINE INPUT PARAMETER excelAppl AS COMPONENT-HANDLE NO-UNDO.
  471. DEFINE INPUT PARAMETER Kolonne AS CHARACTER NO-UNDO.
  472. DEFINE INPUT PARAMETER Zeile AS INTEGER NO-UNDO.
  473. DEFINE INPUT PARAMETER Wert AS CHARACTER NO-UNDO.
  474. DEFINE VARIABLE Zelle AS CHARACTER NO-UNDO.
  475. Zelle = Kolonne + TRIM(STRING(Zeile,"zzzzz9")).
  476. excelAppl:Range(Zelle):Select.
  477. excelAppl:ActiveCell:FormulaR1C1 = Wert.
  478. END PROCEDURE.
  479. /* _UIB-CODE-BLOCK-END */
  480. &ANALYZE-RESUME
  481. &ENDIF
  482. /* ************************ Function Implementations ***************** */
  483. &IF DEFINED(EXCLUDE-CREATEEXCEL) = 0 &THEN
  484. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION CREATEEXCEL Procedure
  485. FUNCTION CREATEEXCEL RETURNS COMPONENT-HANDLE
  486. ( /* parameter-definitions */ ) :
  487. /*------------------------------------------------------------------------------
  488. Purpose:
  489. Notes:
  490. ------------------------------------------------------------------------------*/
  491. DEFINE VARIABLE hdExcel AS COMPONENT-HANDLE NO-UNDO.
  492. DEFINE VARIABLE lOk AS LOGICAL NO-UNDO.
  493. DEFINE VARIABLE cWert AS CHARACTER NO-UNDO.
  494. DO WHILE TRUE:
  495. CREATE "Excel.Application" hdExcel CONNECT NO-ERROR.
  496. IF VALID-HANDLE(hdExcel) THEN LEAVE.
  497. CREATE "Excel.Application" hdExcel NO-ERROR.
  498. LEAVE.
  499. END.
  500. IF NOT VALID-HANDLE(hdExcel) THEN RETURN hdExcel.
  501. lOk = ?.
  502. hdExcel:VISIBLE = TRUE NO-ERROR.
  503. lOk = hdExcel:VISIBLE NO-ERROR.
  504. IF lOk = ? THEN
  505. DO:
  506. RELEASE OBJECT hdExcel NO-ERROR.
  507. RETURN hdExcel.
  508. END.
  509. RETURN hdExcel.
  510. END FUNCTION.
  511. /* _UIB-CODE-BLOCK-END */
  512. &ANALYZE-RESUME
  513. &ENDIF
  514. &IF DEFINED(EXCLUDE-CREATEWORD) = 0 &THEN
  515. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION CREATEWORD Procedure
  516. FUNCTION CREATEWORD RETURNS COMPONENT-HANDLE
  517. ( /* parameter-definitions */ ) :
  518. /*------------------------------------------------------------------------------
  519. Purpose:
  520. Notes:
  521. ------------------------------------------------------------------------------*/
  522. DEFINE VARIABLE hdWord AS COMPONENT-HANDLE NO-UNDO.
  523. DO WHILE TRUE:
  524. CREATE "Word.Application" hdWord CONNECT NO-ERROR.
  525. IF VALID-HANDLE(hdWord) THEN LEAVE.
  526. CREATE "Word.Application" hdWord NO-ERROR.
  527. IF VALID-HANDLE(hdWord) THEN hdWord:Visible = TRUE.
  528. LEAVE.
  529. END.
  530. RETURN hdWord.
  531. END FUNCTION.
  532. /* _UIB-CODE-BLOCK-END */
  533. &ANALYZE-RESUME
  534. &ENDIF
  535. &IF DEFINED(EXCLUDE-RELEASEEXCEL) = 0 &THEN
  536. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION RELEASEEXCEL Procedure
  537. FUNCTION RELEASEEXCEL RETURNS CHARACTER
  538. ( excelAppl AS COMPONENT-HANDLE ) :
  539. /*------------------------------------------------------------------------------
  540. Purpose:
  541. Notes:
  542. ------------------------------------------------------------------------------*/
  543. RELEASE OBJECT excelAppl.
  544. RETURN "".
  545. END FUNCTION.
  546. /* _UIB-CODE-BLOCK-END */
  547. &ANALYZE-RESUME
  548. &ENDIF
  549. &IF DEFINED(EXCLUDE-RELEASEWORD) = 0 &THEN
  550. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION RELEASEWORD Procedure
  551. FUNCTION RELEASEWORD RETURNS CHARACTER
  552. ( wordAppl AS COMPONENT-HANDLE ) :
  553. /*------------------------------------------------------------------------------
  554. Purpose:
  555. Notes:
  556. ------------------------------------------------------------------------------*/
  557. RELEASE OBJECT wordAppl.
  558. RETURN "".
  559. END FUNCTION.
  560. /* _UIB-CODE-BLOCK-END */
  561. &ANALYZE-RESUME
  562. &ENDIF