1VERSION 5.00 2Begin VB.Form frmWizard 3 Appearance = 0 'Flat 4 BackColor = &H80000005& 5 BorderStyle = 1 'Fixed Single 6 Caption = "OpenOffice.org Document Analysis Wizard" 7 ClientHeight = 5520 8 ClientLeft = 1965 9 ClientTop = 1815 10 ClientWidth = 8175 11 BeginProperty Font 12 Name = "Arial" 13 Size = 8.25 14 Charset = 0 15 Weight = 400 16 Underline = 0 'False 17 Italic = 0 'False 18 Strikethrough = 0 'False 19 EndProperty 20 Icon = "Wizard.frx":0000 21 KeyPreview = -1 'True 22 LinkTopic = "Form1" 23 LockControls = -1 'True 24 MaxButton = 0 'False 25 MinButton = 0 'False 26 ScaleHeight = 5520 27 ScaleWidth = 8175 28 Tag = "1000" 29 Begin VB.Frame fraStep 30 BorderStyle = 0 'None 31 Caption = "Introduction" 32 ClipControls = 0 'False 33 Enabled = 0 'False 34 BeginProperty Font 35 Name = "MS Sans Serif" 36 Size = 8.25 37 Charset = 0 38 Weight = 400 39 Underline = 0 'False 40 Italic = 0 'False 41 Strikethrough = 0 'False 42 EndProperty 43 Height = 4905 44 Index = 0 45 Left = -10000 46 TabIndex = 25 47 Tag = "1000" 48 Top = 0 49 Width = 8235 50 Begin VB.PictureBox Picture4 51 Appearance = 0 'Flat 52 BackColor = &H80000005& 53 BorderStyle = 0 'None 54 ForeColor = &H80000008& 55 Height = 4935 56 Index = 0 57 Left = 0 58 ScaleHeight = 4935 59 ScaleWidth = 2565 60 TabIndex = 2 61 TabStop = 0 'False 62 Top = 0 63 Width = 2565 64 Begin VB.PictureBox Picture10 65 Height = 735 66 Left = 2580 67 ScaleHeight = 735 68 ScaleWidth = 30 69 TabIndex = 68 70 TabStop = 0 'False 71 Top = 2610 72 Width = 30 73 End 74 Begin VB.PictureBox Picture6 75 Appearance = 0 'Flat 76 BackColor = &H80000005& 77 BorderStyle = 0 'None 78 ForeColor = &H80000008& 79 Height = 1485 80 Left = 150 81 ScaleHeight = 1485 82 ScaleWidth = 2355 83 TabIndex = 67 84 TabStop = 0 'False 85 Top = 3390 86 Width = 2355 87 Begin VB.PictureBox Picture1 88 Appearance = 0 'Flat 89 BackColor = &H80000005& 90 BorderStyle = 0 'None 91 ForeColor = &H80000008& 92 Height = 1200 93 Index = 0 94 Left = 200 95 Picture = "Wizard.frx":482C2 96 ScaleHeight = 1200 97 ScaleWidth = 1980 98 TabIndex = 7 99 TabStop = 0 'False 100 Tag = "1060" 101 Top = 300 102 Width = 1980 103 End 104 End 105 Begin VB.Label lblStep1_4 106 BackColor = &H00EED3C2& 107 BackStyle = 0 'Transparent 108 Caption = "4. Analyze" 109 ForeColor = &H00BF4F59& 110 Height = 195 111 Left = 120 112 TabIndex = 89 113 Tag = "1044" 114 Top = 1800 115 Width = 2140 116 End 117 Begin VB.Line Line2 118 BorderColor = &H00808080& 119 Index = 2 120 X1 = 2550 121 X2 = 2550 122 Y1 = 0 123 Y2 = 4920 124 End 125 Begin VB.Line Line3 126 Index = 1 127 X1 = 120 128 X2 = 2280 129 Y1 = 480 130 Y2 = 480 131 End 132 Begin VB.Label Label7 133 BackColor = &H00EED3C2& 134 Caption = "1. Introduction" 135 ForeColor = &H00BF4F59& 136 Height = 255 137 Index = 1 138 Left = 120 139 TabIndex = 11 140 Tag = "1041" 141 Top = 720 142 Width = 2140 143 End 144 Begin VB.Label Label8 145 BackColor = &H00EED3C2& 146 BackStyle = 0 'Transparent 147 Caption = "3. Results" 148 ForeColor = &H00BF4F59& 149 Height = 255 150 Index = 1 151 Left = 120 152 TabIndex = 9 153 Tag = "1043" 154 Top = 1440 155 Width = 2140 156 End 157 Begin VB.Label Label9 158 BackColor = &H00EED3C2& 159 BackStyle = 0 'Transparent 160 Caption = "2. Documents" 161 ForeColor = &H00BF4F59& 162 Height = 255 163 Index = 1 164 Left = 120 165 TabIndex = 10 166 Tag = "1042" 167 Top = 1080 168 Width = 2140 169 End 170 Begin VB.Label Label12 171 BackStyle = 0 'Transparent 172 Caption = "Steps" 173 BeginProperty Font 174 Name = "Arial" 175 Size = 8.25 176 Charset = 0 177 Weight = 700 178 Underline = 0 'False 179 Italic = 0 'False 180 Strikethrough = 0 'False 181 EndProperty 182 Height = 255 183 Index = 1 184 Left = 120 185 TabIndex = 8 186 Tag = "1040" 187 Top = 240 188 Width = 2115 189 End 190 End 191 Begin VB.PictureBox Picture8 192 Appearance = 0 'Flat 193 BorderStyle = 0 'None 194 ForeColor = &H80000008& 195 Height = 4935 196 Left = 2400 197 ScaleHeight = 4935 198 ScaleWidth = 5925 199 TabIndex = 3 200 TabStop = 0 'False 201 Top = -30 202 Width = 5925 203 Begin VB.CheckBox chkShowIntro 204 Caption = "Do not show this introduction again" 205 Enabled = 0 'False 206 Height = 315 207 Left = 690 208 MaskColor = &H00000000& 209 TabIndex = 6 210 Tag = "1103" 211 Top = 4890 212 Visible = 0 'False 213 Width = 3810 214 End 215 Begin VB.Label lblIntroduction1 216 AutoSize = -1 'True 217 Caption = $"Wizard.frx":4F8B8 218 Height = 585 219 Left = 690 220 TabIndex = 93 221 Tag = "1101" 222 Top = 750 223 Width = 4890 224 WordWrap = -1 'True 225 End 226 Begin VB.Label lblIntroduction3 227 AutoSize = -1 'True 228 Caption = "The wizard will remain on screen while the analysis is carried out." 229 Height = 195 230 Left = 690 231 TabIndex = 0 232 Tag = "1104" 233 Top = 2670 234 Width = 4845 235 WordWrap = -1 'True 236 End 237 Begin VB.Label lblIntroduction2 238 AutoSize = -1 'True 239 Caption = "You will be able to select which documents you want to analyze as well as where you want the results to the analysis to be saved. " 240 Height = 390 241 Left = 690 242 TabIndex = 1 243 Tag = "1102" 244 Top = 1800 245 Width = 4875 246 WordWrap = -1 'True 247 End 248 Begin VB.Label Label12 249 BackStyle = 0 'Transparent 250 Caption = "Introduction" 251 BeginProperty Font 252 Name = "Arial" 253 Size = 8.25 254 Charset = 0 255 Weight = 700 256 Underline = 0 'False 257 Italic = 0 'False 258 Strikethrough = 0 'False 259 EndProperty 260 Height = 255 261 Index = 2 262 Left = 450 263 TabIndex = 5 264 Tag = "1100" 265 Top = 270 266 Width = 4000 267 End 268 End 269 End 270 Begin VB.Frame fraStep 271 BorderStyle = 0 'None 272 Caption = "Setup" 273 Enabled = 0 'False 274 BeginProperty Font 275 Name = "MS Sans Serif" 276 Size = 8.25 277 Charset = 0 278 Weight = 400 279 Underline = 0 'False 280 Italic = 0 'False 281 Strikethrough = 0 'False 282 EndProperty 283 Height = 4905 284 Index = 1 285 Left = -10000 286 TabIndex = 32 287 Tag = "2000" 288 Top = 0 289 Width = 8235 290 Begin VB.PictureBox Picture4 291 Appearance = 0 'Flat 292 BackColor = &H80000005& 293 BorderStyle = 0 'None 294 ForeColor = &H80000008& 295 Height = 4905 296 Index = 1 297 Left = 0 298 ScaleHeight = 4905 299 ScaleWidth = 2565 300 TabIndex = 61 301 TabStop = 0 'False 302 Top = 0 303 Width = 2565 304 Begin VB.PictureBox Picture1 305 Appearance = 0 'Flat 306 BackColor = &H80000005& 307 BorderStyle = 0 'None 308 ForeColor = &H80000008& 309 Height = 1200 310 Index = 1 311 Left = 350 312 Picture = "Wizard.frx":4F971 313 ScaleHeight = 1200 314 ScaleWidth = 1980 315 TabIndex = 62 316 TabStop = 0 'False 317 Tag = "1060" 318 Top = 3690 319 Width = 1980 320 End 321 Begin VB.Label lblStep2_4 322 BackColor = &H00EED3C2& 323 BackStyle = 0 'Transparent 324 Caption = "4. Analyze" 325 ForeColor = &H00BF4F59& 326 Height = 195 327 Left = 120 328 TabIndex = 90 329 Tag = "1044" 330 Top = 1800 331 Width = 2140 332 End 333 Begin VB.Line Line2 334 BorderColor = &H00808080& 335 Index = 1 336 X1 = 2550 337 X2 = 2550 338 Y1 = 0 339 Y2 = 4920 340 End 341 Begin VB.Label Label12 342 BackStyle = 0 'Transparent 343 Caption = "Steps" 344 BeginProperty Font 345 Name = "Arial" 346 Size = 8.25 347 Charset = 0 348 Weight = 700 349 Underline = 0 'False 350 Italic = 0 'False 351 Strikethrough = 0 'False 352 EndProperty 353 Height = 255 354 Index = 3 355 Left = 120 356 TabIndex = 66 357 Tag = "1040" 358 Top = 240 359 Width = 1335 360 End 361 Begin VB.Label Label9 362 BackColor = &H00EED3C2& 363 Caption = "2. Documents" 364 ForeColor = &H00BF4F59& 365 Height = 255 366 Index = 2 367 Left = 120 368 TabIndex = 65 369 Tag = "1042" 370 Top = 1080 371 Width = 2140 372 End 373 Begin VB.Label Label8 374 BackColor = &H00EED3C2& 375 BackStyle = 0 'Transparent 376 Caption = "3. Results" 377 ForeColor = &H00BF4F59& 378 Height = 255 379 Index = 2 380 Left = 120 381 TabIndex = 64 382 Tag = "1043" 383 Top = 1440 384 Width = 2140 385 End 386 Begin VB.Label Label7 387 BackColor = &H00EED3C2& 388 BackStyle = 0 'Transparent 389 Caption = "1. Introduction" 390 ForeColor = &H00BF4F59& 391 Height = 255 392 Index = 2 393 Left = 120 394 TabIndex = 63 395 Tag = "1041" 396 Top = 720 397 Width = 2140 398 End 399 Begin VB.Line Line3 400 Index = 2 401 X1 = 120 402 X2 = 2280 403 Y1 = 480 404 Y2 = 480 405 End 406 End 407 Begin VB.PictureBox Picture7 408 Appearance = 0 'Flat 409 BorderStyle = 0 'None 410 ForeColor = &H80000008& 411 Height = 4725 412 Left = 2580 413 ScaleHeight = 4725 414 ScaleWidth = 5535 415 TabIndex = 58 416 TabStop = 0 'False 417 Top = 0 418 Width = 5535 419 Begin VB.ComboBox cbIgnoreOld 420 Height = 330 421 ItemData = "Wizard.frx":56F67 422 Left = 3950 423 List = "Wizard.frx":56F74 424 Style = 2 'Dropdown List 425 TabIndex = 99 426 Top = 1570 427 Width = 1215 428 End 429 Begin VB.CheckBox chkIgnoreOld 430 Caption = "Ignore documents older than" 431 Height = 225 432 Left = 450 433 TabIndex = 98 434 Top = 1600 435 Width = 3400 436 End 437 Begin VB.CheckBox chkWordDoc 438 Caption = "Documents (*.doc)" 439 Height = 225 440 Left = 2160 441 TabIndex = 19 442 Tag = "1208" 443 Top = 2600 444 Value = 1 'Checked 445 Width = 3200 446 End 447 Begin VB.CheckBox chkWordTemplate 448 Caption = "Templates (*.dot)" 449 Height = 225 450 Left = 2160 451 TabIndex = 20 452 Tag = "1209" 453 Top = 2900 454 Width = 3200 455 End 456 Begin VB.CheckBox chkPPTemplate 457 Caption = "Templates (*.pot)" 458 Height = 225 459 Left = 2160 460 TabIndex = 24 461 Tag = "1215" 462 Top = 4400 463 Width = 3200 464 End 465 Begin VB.CheckBox chkPPDoc 466 Caption = "Presentations (*.ppt)" 467 Height = 225 468 Left = 2160 469 TabIndex = 23 470 Tag = "1214" 471 Top = 4100 472 Width = 3200 473 End 474 Begin VB.CheckBox chkExcelDoc 475 Caption = "Spreadsheets (*.xls)" 476 Height = 225 477 Left = 2160 478 TabIndex = 21 479 Tag = "1211" 480 Top = 3350 481 Width = 3200 482 End 483 Begin VB.CheckBox chkExcelTemplate 484 Caption = "Templates (*.xlt)" 485 Height = 225 486 Left = 2160 487 TabIndex = 22 488 Tag = "1212" 489 Top = 3650 490 Width = 3200 491 End 492 Begin VB.CommandButton btnBrowseDirInput 493 Caption = "..." 494 Height = 315 495 Left = 4740 496 TabIndex = 17 497 Top = 900 498 Width = 400 499 End 500 Begin VB.TextBox txtInputDir 501 Height = 315 502 Left = 450 503 TabIndex = 16 504 Tag = "1205" 505 Text = "C:\" 506 Top = 900 507 Width = 4155 508 End 509 Begin VB.CheckBox chkIncludeSubdirs 510 Caption = "Include subdirectories in the analysis" 511 Height = 225 512 Left = 450 513 TabIndex = 18 514 Tag = "1202" 515 Top = 1300 516 Width = 4965 517 End 518 Begin VB.Label lblDocTypes 519 Caption = "Document types to analyze" 520 Height = 225 521 Left = 450 522 TabIndex = 95 523 Tag = "1206" 524 Top = 2250 525 Width = 4905 526 End 527 Begin VB.Label lblChooseDocs 528 AutoSize = -1 'True 529 Caption = "Choose the documents you want to analyze" 530 BeginProperty Font 531 Name = "Arial" 532 Size = 8.25 533 Charset = 0 534 Weight = 700 535 Underline = 0 'False 536 Italic = 0 'False 537 Strikethrough = 0 'False 538 EndProperty 539 Height = 195 540 Left = 300 541 TabIndex = 94 542 Tag = "1200" 543 Top = 240 544 Width = 5115 545 WordWrap = -1 'True 546 End 547 Begin VB.Label Label13 548 AutoSize = -1 'True 549 Caption = "PowerPoint" 550 Height = 225 551 Index = 2 552 Left = 690 553 TabIndex = 74 554 Tag = "1213" 555 Top = 4100 556 Width = 1245 557 WordWrap = -1 'True 558 End 559 Begin VB.Label Label13 560 AutoSize = -1 'True 561 Caption = "Excel" 562 Height = 225 563 Index = 1 564 Left = 690 565 TabIndex = 73 566 Tag = "1210" 567 Top = 3350 568 Width = 1245 569 WordWrap = -1 'True 570 End 571 Begin VB.Label Label13 572 AutoSize = -1 'True 573 Caption = "Word" 574 Height = 225 575 Index = 0 576 Left = 690 577 TabIndex = 72 578 Tag = "1207" 579 Top = 2600 580 Width = 1245 581 WordWrap = -1 'True 582 End 583 Begin VB.Label Label1 584 Caption = "Location of Microsoft Office documents" 585 Height = 200 586 Left = 450 587 TabIndex = 59 588 Tag = "1201" 589 Top = 600 590 Width = 4935 591 End 592 End 593 End 594 Begin VB.Frame fraStep 595 BorderStyle = 0 'None 596 Caption = "Options" 597 Enabled = 0 'False 598 BeginProperty Font 599 Name = "MS Sans Serif" 600 Size = 8.25 601 Charset = 0 602 Weight = 400 603 Underline = 0 'False 604 Italic = 0 'False 605 Strikethrough = 0 'False 606 EndProperty 607 Height = 4905 608 Index = 2 609 Left = -10000 610 TabIndex = 33 611 Tag = "2002" 612 Top = 0 613 Width = 8235 614 Begin VB.PictureBox Picture11 615 BorderStyle = 0 'None 616 Height = 555 617 Left = 7260 618 ScaleHeight = 555 619 ScaleWidth = 705 620 TabIndex = 75 621 Top = 1890 622 Width = 705 623 Begin VB.CommandButton btnBrowseDirOut 624 Caption = "..." 625 Height = 375 626 Left = 90 627 TabIndex = 28 628 Top = 90 629 Width = 495 630 End 631 End 632 Begin VB.TextBox txtResultsName 633 Height = 375 634 Left = 3030 635 TabIndex = 26 636 Tag = "1302" 637 Text = "Analysis Results.xls" 638 Top = 1140 639 Width = 3045 640 End 641 Begin VB.TextBox txtOutputDir 642 Height = 375 643 Left = 3030 644 TabIndex = 27 645 Top = 1980 646 Width = 4185 647 End 648 Begin VB.PictureBox Picture5 649 Appearance = 0 'Flat 650 BorderStyle = 0 'None 651 ForeColor = &H80000008& 652 Height = 1365 653 Left = 3300 654 ScaleHeight = 1365 655 ScaleWidth = 4635 656 TabIndex = 57 657 TabStop = 0 'False 658 Top = 3210 659 Width = 4635 660 Begin VB.OptionButton rdbResultsPrompt 661 Caption = "Ask me before overwriting" 662 Height = 435 663 Left = 0 664 TabIndex = 29 665 Tag = "1312" 666 Top = 0 667 Value = -1 'True 668 Width = 4485 669 End 670 Begin VB.OptionButton rdbResultsOverwrite 671 Caption = "Overwrite without asking me" 672 Height = 435 673 Left = 0 674 TabIndex = 30 675 Tag = "1313" 676 Top = 450 677 Width = 4455 678 End 679 Begin VB.OptionButton rdbResultsAppend 680 Caption = "Append the new results to the existing results" 681 Height = 675 682 Left = 0 683 TabIndex = 31 684 Tag = "1314" 685 Top = 780 686 Visible = 0 'False 687 Width = 4515 688 End 689 End 690 Begin VB.Frame Frame3 691 Appearance = 0 'Flat 692 BackColor = &H80000005& 693 BorderStyle = 0 'None 694 Enabled = 0 'False 695 ForeColor = &H0099A8AC& 696 Height = 5175 697 Index = 0 698 Left = 0 699 TabIndex = 39 700 Top = 0 701 Width = 2535 702 Begin VB.PictureBox Picture1 703 Appearance = 0 'Flat 704 BackColor = &H80000005& 705 BorderStyle = 0 'None 706 ForeColor = &H80000008& 707 Height = 1200 708 Index = 3 709 Left = 350 710 Picture = "Wizard.frx":56F97 711 ScaleHeight = 1200 712 ScaleWidth = 1980 713 TabIndex = 40 714 TabStop = 0 'False 715 Top = 3690 716 Width = 1980 717 End 718 Begin VB.Label lblStep3_4 719 BackColor = &H00EED3C2& 720 BackStyle = 0 'Transparent 721 Caption = "4. Analyze" 722 ForeColor = &H00BF4F59& 723 Height = 195 724 Left = 120 725 TabIndex = 91 726 Tag = "1044" 727 Top = 1800 728 Width = 2140 729 End 730 Begin VB.Label Label12 731 BackStyle = 0 'Transparent 732 Caption = "Steps" 733 BeginProperty Font 734 Name = "Arial" 735 Size = 8.25 736 Charset = 0 737 Weight = 700 738 Underline = 0 'False 739 Italic = 0 'False 740 Strikethrough = 0 'False 741 EndProperty 742 Height = 255 743 Index = 0 744 Left = 120 745 TabIndex = 53 746 Tag = "1040" 747 Top = 240 748 Width = 1335 749 End 750 Begin VB.Label Label9 751 BackColor = &H00EED3C2& 752 BackStyle = 0 'Transparent 753 Caption = "2. Documents" 754 ForeColor = &H00BF4F59& 755 Height = 255 756 Index = 0 757 Left = 120 758 TabIndex = 43 759 Tag = "1042" 760 Top = 1080 761 Width = 2140 762 End 763 Begin VB.Label Label8 764 BackColor = &H00EED3C2& 765 Caption = "3. Results" 766 ForeColor = &H00BF4F59& 767 Height = 255 768 Index = 0 769 Left = 120 770 TabIndex = 42 771 Tag = "1043" 772 Top = 1440 773 Width = 2140 774 End 775 Begin VB.Label Label7 776 BackColor = &H00EED3C2& 777 BackStyle = 0 'Transparent 778 Caption = "1. Introduction" 779 ForeColor = &H00BF4F59& 780 Height = 255 781 Index = 0 782 Left = 120 783 TabIndex = 41 784 Tag = "1041" 785 Top = 720 786 Width = 2140 787 End 788 Begin VB.Line Line3 789 Index = 0 790 X1 = 120 791 X2 = 2280 792 Y1 = 480 793 Y2 = 480 794 End 795 End 796 Begin VB.Label Label3 797 Caption = "File name for the results spreadsheet" 798 Height = 195 799 Left = 3030 800 TabIndex = 71 801 Tag = "1301" 802 Top = 840 803 Width = 4785 804 End 805 Begin VB.Label lblResultsLocation 806 Caption = "Location" 807 Height = 195 808 Left = 3030 809 TabIndex = 70 810 Tag = "1304" 811 Top = 1710 812 Width = 4755 813 End 814 Begin VB.Label Label13 815 AutoSize = -1 'True 816 Caption = "If results already exisit under the same name and location:" 817 Height = 195 818 Index = 5 819 Left = 3030 820 TabIndex = 38 821 Tag = "1311" 822 Top = 2730 823 Width = 4230 824 WordWrap = -1 'True 825 End 826 Begin VB.Line Line2 827 BorderColor = &H00808080& 828 Index = 0 829 X1 = 2550 830 X2 = 2550 831 Y1 = 0 832 Y2 = 4920 833 End 834 Begin VB.Label lblChooseResults 835 AutoSize = -1 'True 836 Caption = "Choose where and how to save the analysis results" 837 BeginProperty Font 838 Name = "Arial" 839 Size = 8.25 840 Charset = 0 841 Weight = 700 842 Underline = 0 'False 843 Italic = 0 'False 844 Strikethrough = 0 'False 845 EndProperty 846 Height = 195 847 Left = 2880 848 TabIndex = 37 849 Tag = "1300" 850 Top = 240 851 Width = 5055 852 WordWrap = -1 'True 853 End 854 End 855 Begin VB.Frame fraStep 856 BorderStyle = 0 'None 857 Caption = "Analyze" 858 Enabled = 0 'False 859 BeginProperty Font 860 Name = "MS Sans Serif" 861 Size = 8.25 862 Charset = 0 863 Weight = 400 864 Underline = 0 'False 865 Italic = 0 'False 866 Strikethrough = 0 'False 867 EndProperty 868 Height = 4905 869 Index = 3 870 Left = 0 871 TabIndex = 34 872 Tag = "3000" 873 Top = 0 874 Width = 2.45745e5 875 Begin VB.PictureBox Picture12 876 Appearance = 0 'Flat 877 BorderStyle = 0 'None 878 ForeColor = &H80000008& 879 Height = 4905 880 Left = 10020 881 ScaleHeight = 4905 882 ScaleWidth = 8175 883 TabIndex = 69 884 TabStop = 0 'False 885 Top = 0 886 Width = 8175 887 End 888 Begin VB.CommandButton btnPrepare 889 Caption = "Prepare" 890 Enabled = 0 'False 891 Height = 375 892 Left = 3340 893 TabIndex = 97 894 Tag = "1411" 895 Top = 4410 896 Visible = 0 'False 897 Width = 4000 898 End 899 Begin VB.CommandButton btnRunAnalysis 900 Caption = "Run" 901 Height = 375 902 Left = 3340 903 TabIndex = 35 904 Tag = "1404" 905 Top = 3410 906 Width = 4000 907 End 908 Begin VB.CommandButton btnViewResults 909 Caption = "View" 910 Enabled = 0 'False 911 Height = 375 912 Left = 3340 913 TabIndex = 36 914 Tag = "1406" 915 Top = 3910 916 Width = 4000 917 End 918 Begin VB.Frame Frame3 919 Appearance = 0 'Flat 920 BackColor = &H80000005& 921 BorderStyle = 0 'None 922 Enabled = 0 'False 923 ForeColor = &H0099A8AC& 924 Height = 5175 925 Index = 3 926 Left = 0 927 TabIndex = 44 928 Top = 0 929 Width = 2535 930 Begin VB.PictureBox Picture4 931 Appearance = 0 'Flat 932 BackColor = &H80000005& 933 BorderStyle = 0 'None 934 ForeColor = &H80000008& 935 Height = 1575 936 Index = 2 937 Left = 150 938 ScaleHeight = 1575 939 ScaleWidth = 2385 940 TabIndex = 55 941 TabStop = 0 'False 942 Top = 3390 943 Width = 2385 944 Begin VB.PictureBox Picture1 945 Appearance = 0 'Flat 946 BackColor = &H80000005& 947 BorderStyle = 0 'None 948 ForeColor = &H80000008& 949 Height = 1200 950 Index = 2 951 Left = 200 952 Picture = "Wizard.frx":5E58D 953 ScaleHeight = 1200 954 ScaleWidth = 2475 955 TabIndex = 56 956 TabStop = 0 'False 957 Tag = "1060" 958 Top = 300 959 Width = 2480 960 End 961 End 962 Begin VB.Label lblStep4_4 963 BackColor = &H00EED3C2& 964 Caption = "4. Analyze" 965 ForeColor = &H00BF4F59& 966 Height = 255 967 Left = 120 968 TabIndex = 92 969 Tag = "1044" 970 Top = 1800 971 Width = 2140 972 End 973 Begin VB.Label Label12 974 BackStyle = 0 'Transparent 975 Caption = "Steps" 976 BeginProperty Font 977 Name = "Arial" 978 Size = 8.25 979 Charset = 0 980 Weight = 700 981 Underline = 0 'False 982 Italic = 0 'False 983 Strikethrough = 0 'False 984 EndProperty 985 Height = 255 986 Index = 5 987 Left = 120 988 TabIndex = 54 989 Tag = "1040" 990 Top = 240 991 Width = 1335 992 End 993 Begin VB.Label Label9 994 BackColor = &H00EED3C2& 995 BackStyle = 0 'Transparent 996 Caption = "2. Documents" 997 ForeColor = &H00BF4F59& 998 Height = 255 999 Index = 3 1000 Left = 120 1001 TabIndex = 47 1002 Tag = "1042" 1003 Top = 1080 1004 Width = 2140 1005 End 1006 Begin VB.Label Label8 1007 BackColor = &H00EED3C2& 1008 BackStyle = 0 'Transparent 1009 Caption = "3. Results" 1010 ForeColor = &H00BF4F59& 1011 Height = 255 1012 Index = 3 1013 Left = 120 1014 TabIndex = 46 1015 Tag = "1043" 1016 Top = 1440 1017 Width = 2140 1018 End 1019 Begin VB.Label Label7 1020 BackColor = &H00EED3C2& 1021 BackStyle = 0 'Transparent 1022 Caption = "1. Introduction" 1023 ForeColor = &H00BF4F59& 1024 Height = 255 1025 Index = 3 1026 Left = 120 1027 TabIndex = 45 1028 Tag = "1041" 1029 Top = 720 1030 Width = 2140 1031 End 1032 Begin VB.Line Line3 1033 Index = 3 1034 X1 = 120 1035 X2 = 2280 1036 Y1 = 480 1037 Y2 = 480 1038 End 1039 End 1040 Begin VB.Label lblSkippedOld 1041 Caption = "Skipped <TOPIC> documets, because they were too old" 1042 Height = 195 1043 Left = 3180 1044 TabIndex = 60 1045 Top = 2880 1046 Width = 4935 1047 End 1048 Begin VB.Label lblSetupDone 1049 AutoSize = -1 'True 1050 Caption = "Run the analysis and view the results" 1051 BeginProperty Font 1052 Name = "Arial" 1053 Size = 8.25 1054 Charset = 0 1055 Weight = 700 1056 Underline = 0 'False 1057 Italic = 0 'False 1058 Strikethrough = 0 'False 1059 EndProperty 1060 Height = 195 1061 Left = 2880 1062 TabIndex = 96 1063 Tag = "1400" 1064 Top = 240 1065 Width = 4905 1066 WordWrap = -1 'True 1067 End 1068 Begin VB.Label lblNumPPT 1069 Caption = "<TOPIC> Presentations" 1070 Height = 255 1071 Left = 4620 1072 TabIndex = 88 1073 Tag = "1409" 1074 Top = 2280 1075 Width = 3375 1076 End 1077 Begin VB.Label lblNumPOT 1078 Caption = "<TOPIC> Templates" 1079 Height = 255 1080 Left = 4620 1081 TabIndex = 87 1082 Tag = "1403" 1083 Top = 2550 1084 Width = 3375 1085 End 1086 Begin VB.Label lblNumXLS 1087 Caption = "<TOPIC> Spreadsheets" 1088 Height = 255 1089 Left = 4620 1090 TabIndex = 86 1091 Tag = "1408" 1092 Top = 1680 1093 Width = 3375 1094 End 1095 Begin VB.Label lblNumXLT 1096 Caption = "<TOPIC> Templates" 1097 Height = 255 1098 Left = 4620 1099 TabIndex = 85 1100 Tag = "1403" 1101 Top = 1950 1102 Width = 3375 1103 End 1104 Begin VB.Label Label16 1105 AutoSize = -1 'True 1106 Caption = "PowerPoint" 1107 Height = 195 1108 Left = 3360 1109 TabIndex = 82 1110 Tag = "1213" 1111 Top = 2280 1112 Width = 1095 1113 WordWrap = -1 'True 1114 End 1115 Begin VB.Label Label13 1116 Caption = "Word" 1117 Height = 705 1118 Index = 10 1119 Left = 0 1120 TabIndex = 81 1121 Tag = "1207" 1122 Top = 0 1123 Width = 1245 1124 End 1125 Begin VB.Label Label13 1126 Caption = "Excel" 1127 Height = 705 1128 Index = 9 1129 Left = 0 1130 TabIndex = 80 1131 Tag = "1210" 1132 Top = 810 1133 Width = 1245 1134 End 1135 Begin VB.Label Label13 1136 Caption = "PowerPoint" 1137 Height = 585 1138 Index = 8 1139 Left = 0 1140 TabIndex = 79 1141 Tag = "1213" 1142 Top = 1620 1143 Width = 1245 1144 End 1145 Begin VB.Label Label13 1146 Caption = "Word" 1147 Height = 585 1148 Index = 7 1149 Left = 0 1150 TabIndex = 78 1151 Tag = "1207" 1152 Top = 0 1153 Width = 1245 1154 End 1155 Begin VB.Label Label13 1156 Caption = "Excel" 1157 Height = 585 1158 Index = 6 1159 Left = 0 1160 TabIndex = 77 1161 Tag = "1210" 1162 Top = 810 1163 Width = 1245 1164 End 1165 Begin VB.Label Label13 1166 Caption = "PowerPoint" 1167 Height = 465 1168 Index = 4 1169 Left = 0 1170 TabIndex = 76 1171 Tag = "1213" 1172 Top = 1620 1173 Width = 1245 1174 End 1175 Begin VB.Label lblNumTemplates 1176 Caption = "<TOPIC> Templates" 1177 Height = 255 1178 Left = 4620 1179 TabIndex = 52 1180 Tag = "1403" 1181 Top = 1350 1182 Width = 3375 1183 End 1184 Begin VB.Label lblNumDocs 1185 Caption = "<TOPIC> Documents" 1186 Height = 255 1187 Left = 4620 1188 TabIndex = 51 1189 Tag = "1402" 1190 Top = 1080 1191 Width = 3375 1192 End 1193 Begin VB.Line Line6 1194 BorderColor = &H00808080& 1195 X1 = 2640 1196 X2 = 8040 1197 Y1 = 3270 1198 Y2 = 3270 1199 End 1200 Begin VB.Label Label15 1201 AutoSize = -1 'True 1202 Caption = "Excel" 1203 Height = 195 1204 Left = 3360 1205 TabIndex = 50 1206 Tag = "1210" 1207 Top = 1680 1208 Width = 1095 1209 WordWrap = -1 'True 1210 End 1211 Begin VB.Label Label14 1212 AutoSize = -1 'True 1213 Caption = "Word" 1214 Height = 195 1215 Left = 3360 1216 TabIndex = 49 1217 Tag = "1207" 1218 Top = 1080 1219 Width = 1110 1220 WordWrap = -1 'True 1221 End 1222 Begin VB.Label lblTotalNumDocs 1223 AutoSize = -1 'True 1224 Caption = "A total of <TOPIC> documents will be analyzed:" 1225 Height = 195 1226 Left = 3180 1227 TabIndex = 48 1228 Tag = "1401" 1229 Top = 660 1230 Width = 4800 1231 WordWrap = -1 'True 1232 End 1233 Begin VB.Line Line2 1234 BorderColor = &H00808080& 1235 Index = 3 1236 X1 = 2550 1237 X2 = 2550 1238 Y1 = 0 1239 Y2 = 4920 1240 End 1241 End 1242 Begin VB.PictureBox picNav 1243 Align = 2 'Align Bottom 1244 Appearance = 0 'Flat 1245 BorderStyle = 0 'None 1246 BeginProperty Font 1247 Name = "MS Sans Serif" 1248 Size = 8.25 1249 Charset = 0 1250 Weight = 400 1251 Underline = 0 'False 1252 Italic = 0 'False 1253 Strikethrough = 0 'False 1254 EndProperty 1255 ForeColor = &H80000008& 1256 Height = 570 1257 Left = 0 1258 ScaleHeight = 570 1259 ScaleWidth = 8175 1260 TabIndex = 4 1261 TabStop = 0 'False 1262 Top = 4950 1263 Width = 8175 1264 Begin VB.CommandButton cmdNav 1265 Caption = "Finish" 1266 Height = 312 1267 Index = 4 1268 Left = 5325 1269 MaskColor = &H00000000& 1270 TabIndex = 14 1271 Tag = "1023" 1272 Top = 120 1273 Width = 1320 1274 End 1275 Begin VB.CommandButton cmdNav 1276 Caption = "Next >>" 1277 Height = 312 1278 Index = 3 1279 Left = 3870 1280 MaskColor = &H00000000& 1281 TabIndex = 13 1282 Tag = "1022" 1283 Top = 120 1284 Width = 1320 1285 End 1286 Begin VB.CommandButton cmdNav 1287 Caption = "<< Back" 1288 Height = 312 1289 Index = 2 1290 Left = 2535 1291 MaskColor = &H00000000& 1292 TabIndex = 12 1293 Tag = "1021" 1294 Top = 120 1295 Width = 1320 1296 End 1297 Begin VB.CommandButton cmdNav 1298 Cancel = -1 'True 1299 Caption = "Cancel" 1300 Height = 312 1301 Index = 1 1302 Left = 6750 1303 MaskColor = &H00000000& 1304 TabIndex = 15 1305 Tag = "1024" 1306 Top = 120 1307 Width = 1320 1308 End 1309 End 1310 Begin VB.Label Label18 1311 Caption = "<TOPIC> Documents" 1312 Height = 255 1313 Left = 0 1314 TabIndex = 84 1315 Top = 0 1316 Width = 2085 1317 WordWrap = -1 'True 1318 End 1319 Begin VB.Label Label17 1320 Caption = "<TOPIC> Templates" 1321 Height = 255 1322 Left = 0 1323 TabIndex = 83 1324 Top = 390 1325 Width = 3615 1326 WordWrap = -1 'True 1327 End 1328 Begin VB.Line Line4 1329 BorderColor = &H00808080& 1330 X1 = 0 1331 X2 = 8160 1332 Y1 = 4920 1333 Y2 = 4920 1334 End 1335End 1336Attribute VB_Name = "frmWizard" 1337Attribute VB_GlobalNameSpace = False 1338Attribute VB_Creatable = False 1339Attribute VB_PredeclaredId = True 1340Attribute VB_Exposed = False 1341' ******************************************************************************* 1342' * 1343' * Copyright 2000, 2010 Oracle and/or its affiliates. All rights reserved. Use of this 1344' * product is subject to license terms. 1345' * 1346' ******************************************************************************* 1347 1348Option Explicit 1349 1350Const TOPIC_STR = "<TOPIC>" 1351Const TOPIC2_STR = "<TOPIC2>" 1352Const CR_STR = "<CR>" 1353Const CDEBUG_LEVEL_DEFAULT = 1 'Will output all Debug output to analysis.log file 1354Const CSUPPORTED_VERSION = 9# 1355 1356Const NUM_STEPS = 4 1357 1358Const CAPPNAME_WORD = "Word" 1359Const CAPPNAME_EXCEL = "Excel" 1360Const CAPPNAME_POWERPOINT = "PowerPoint" 1361Const CANALYZING = "Analyzing" 1362 1363Const BTN_CANCEL = 1 1364Const BTN_BACK = 2 1365Const BTN_NEXT = 3 1366Const BTN_FINISH = 4 1367 1368Const STEP_INTRO = 0 1369Const STEP_1 = 1 1370Const STEP_2 = 2 1371Const STEP_FINISH = 3 1372 1373Const DIR_NONE = 0 1374Const DIR_BACK = 1 1375Const DIR_NEXT = 2 1376 1377Const CPRODUCTNAME_STR = "<PRODUCTNAME>" 1378 1379Const CSTR_ANALYSIS_LOG_DONE = "Done" 1380 1381Const CINPUT_DIR = "indir" 1382Const COUTPUT_DIR = "outdir" 1383Const CRESULTS_FILE = "resultsfile" 1384Const CLOG_FILE = "logfile" 1385Const CRESULTS_TEMPLATE = "resultstemplate" 1386Const CRESULTS_EXIST = "resultsexist" 1387Const CPROMPT_FILE = "promptfile" 1388Const COVERWRITE_FILE = "overwritefile" 1389Const CAPPEND_FILE = "appendfile" 1390Const CNEW_RESULTS_FILE = "newresultsfile" 1391Const CINCLUDE_SUBDIRS = "includesubdirs" 1392Const CDEBUG_LEVEL = "debuglevel" 1393Const CTYPE_WORDDOC = "typeworddoc" 1394Const CTYPE_WORDDOT = "typeworddot" 1395Const CTYPE_EXCELDOC = "typeexceldoc" 1396Const CTYPE_EXCELDOT = "typeexceldot" 1397Const CTYPE_PPDOC = "typepowerpointdoc" 1398Const CTYPE_PPDOT = "typepowerpointdot" 1399Const COUTPUT_TYPE = "outputtype" 1400Const COUTPUT_TYPE_XLS = "xls" 1401Const COUTPUT_TYPE_XML = "xml" 1402Const COUTPUT_TYPE_BOTH = "both" 1403Const CVERSION = "version" 1404Const CDOPREPARE = "prepare" 1405Const CTITLE = "title" 1406Const CIGNORE_OLD_DOCS = "ignoreolddocuments" 1407Const CISSUE_LIMIT = "issuesmonthlimit" 1408Const CISSUE_LIMIT_DAW = 6 1409Private mIssueLimit As Integer 1410Const CDEFAULT_PASSWORD = "defaultpassword" 1411Const CSTR_TEST_PASSWORD = "test" 1412Private mDefaultPassword As String 1413 1414Const CLAST_CHECKPOINT As String = "LastCheckpoint" 1415Const CNEXT_FILE As String = "NextFile" 1416Const C_ABORT_ANALYSIS As String = "AbortAnalysis" 1417 1418Const CNUMBER_TOTAL_DOCS = "total_numberdocs" 1419Const CNUMBER_DOCS_DOC = "numberdocs_doc" 1420Const CNUMBER_TEMPLATES_DOT = "numbertemplates_dot" 1421Const CNUMBER_DOCS_XLS = "numberdocs_xls" 1422Const CNUMBER_TEMPLATES_XLT = "numbertemplates_xlt" 1423Const CNUMBER_DOCS_PPT = "numberdocs_ppt" 1424Const CNUMBER_TEMPLATES_POT = "numbertemplates_pot" 1425Const CSTART_TIME = "start" 1426Const CEND_TIME = "end" 1427Const CELAPSED_TIME = "time_for_analysis" 1428Const CWINVERSION = "win_version" 1429Const CUSER_LOCALE_INFO = "user_locale" 1430Const CSYS_LOCALE_INFO = "system_locale" 1431Const CWORD_VERSION = "word_ver" 1432Const CEXCEL_VERSION = "excel_ver" 1433Const CPOWERPOINT_VERSION = "powerpoint_ver" 1434Const CNOT_INSTALLED = "not installed" 1435 1436Const CRESULTS_FILE_EXTENSION = ".xls" 1437Const CCONFIG_BACKUP_EXT = "_bak" 1438Const CDEFAULT_README_NAME = "UserGuide" 1439 1440Const C_DOCS_LESS_3_MONTH = "DocumentsYoungerThan3Month" 1441Const C_DOCS_LESS_6_MONTH = "DocumentsYoungerThan6Month" 1442Const C_DOCS_LESS_12_MONTH = "DocumentsYoungerThan12Month" 1443Const C_DOCS_MORE_12_MONTH = "DocumentsOlderThan12Month" 1444 1445'module level vars 1446Dim mnCurStep As Integer 1447Dim mbTrue As Boolean 1448Dim mbFalse As Boolean 1449Dim mLblSteps As String 1450Dim mChbSubdirs As String 1451 1452Dim mWordDocCount As Long 1453Dim mExcelDocCount As Long 1454Dim mPPDocCount As Long 1455 1456Dim mWordTemplateCount As Long 1457Dim mExcelTemplateCount As Long 1458Dim mPPTemplateCount As Long 1459Dim mTotalDocCount As Long 1460Dim mIgnoredDocCount As Long 1461 1462Public VBInst As VBIDE.VBE 1463Dim mbFinishOK As Boolean 1464Dim mbAllowExit As Boolean 1465Private mStrTrue As String 1466Private mLogFilePath As String 1467Private mDebugLevel As String 1468Private mIniFilePath As String 1469Private mbDocCountCurrent As Boolean 1470Private mbDoPrepare As Boolean 1471 1472Dim mDocFiles As CollectedFiles 1473 1474Private Declare Sub InitCommonControls Lib "comctl32" () 1475Private Declare Function GetTickCount Lib "kernel32" () As Long 1476Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 1477 1478Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 1479 1480Private Declare Function FormatMessage Lib "kernel32" Alias _ 1481 "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _ 1482 ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _ 1483 ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Any) As Long 1484 1485 1486Private Const HKEY_CURRENT_USER As Long = &H80000001 1487Private Const HKEY_LOCAL_MACHINE As Long = &H80000002 1488 1489Const WORD_APP = "word" 1490Const EXCEL_APP = "excel" 1491Const PP_APP = "pp" 1492Const REG_KEY_APP_PATH = "Software\Microsoft\Windows\CurrentVersion\App Paths\" 1493 1494 1495Function GetAppPath(myApp As String) As String 1496 Dim myPath As String 1497 1498 If (myApp = WORD_APP) Then 1499 myPath = GetRegistryInfo(HKEY_LOCAL_MACHINE, REG_KEY_APP_PATH & "winword.exe", "") 1500 ElseIf (myApp = EXCEL_APP) Then 1501 myPath = GetRegistryInfo(HKEY_LOCAL_MACHINE, REG_KEY_APP_PATH & "excel.exe", "") 1502 ElseIf (myApp = PP_APP) Then 1503 myPath = GetRegistryInfo(HKEY_LOCAL_MACHINE, REG_KEY_APP_PATH & "powerpnt.exe", "") 1504 Else 1505 MsgBox "Unknown application: " & myApp, vbCritical 1506 Exit Function 1507 End If 1508 1509 If (myPath = "") Then 1510 If (myApp = WORD_APP) Then 1511 myPath = GetRegistryInfo(HKEY_CURRENT_USER, REG_KEY_APP_PATH & "winword.exe", "") 1512 ElseIf (myApp = EXCEL_APP) Then 1513 myPath = GetRegistryInfo(HKEY_CURRENT_USER, REG_KEY_APP_PATH & "excel.exe", "") 1514 ElseIf (myApp = PP_APP) Then 1515 myPath = GetRegistryInfo(HKEY_CURRENT_USER, REG_KEY_APP_PATH & "powerpnt.exe", "") 1516 End If 1517 End If 1518 1519 GetAppPath = myPath 1520End Function 1521 1522Function GetDriverDoc(myApp As String) As String 1523 Dim myPath As String 1524 Dim errStr As String 1525 Dim fso As New FileSystemObject 1526 1527 If (myApp = WORD_APP) Then 1528 myPath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CWORD_DRIVER_FILE) 1529 ElseIf (myApp = EXCEL_APP) Then 1530 myPath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CEXCEL_DRIVER_FILE) 1531 ElseIf (myApp = PP_APP) Then 1532 myPath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CPP_DRIVER_FILE) 1533 Else 1534 MsgBox "Unknown application: " & myApp, vbCritical 1535 GoTo FinalExit 1536 End If 1537 1538 If Not fso.FileExists(myPath) Then 1539 errStr = ReplaceTopic2Tokens(GetResString(ERR_MISSING_WORD_DRIVER), _ 1540 TOPIC_STR, myPath, CR_STR, Chr(13)) 1541 WriteDebug errStr 1542 MsgBox errStr, vbCritical 1543 GoTo FinalExit 1544 End If 1545 1546 GetDriverDoc = myPath 1547 1548FinalExit: 1549 Set fso = Nothing 1550End Function 1551 1552 1553 1554 1555Private Function AutomationMessageText(lCode As Long) As String 1556 Dim sRtrnCode As String 1557 Dim lRet As Long 1558 1559 sRtrnCode = Space$(256) 1560 lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, lCode, 0&, _ 1561 sRtrnCode, 256&, 0&) 1562 If lRet > 0 Then 1563 AutomationMessageText = Left(sRtrnCode, lRet) 1564 Else 1565 AutomationMessageText = "Error not found." 1566 End If 1567 1568End Function 1569 1570Private Sub btnBrowseDirInput_Click() 1571 Dim folder As String 1572 Dim StartDir As String 1573 1574 If Len(txtInputDir.Text) > 0 Then 1575 StartDir = txtInputDir.Text 1576 End If 1577 1578 folder = BrowseForFolder(Me, GetResString(BROWSE_FOR_DOC_DIR_ID), StartDir) 1579 If Len(folder) = 0 Then 1580 Exit Sub 'User Selected Cancel 1581 End If 1582 txtInputDir.Text = folder 1583 txtInputDir.ToolTipText = folder 1584 1585 If Len(txtOutputDir.Text) = 0 Then 1586 txtOutputDir.Text = folder 1587 txtOutputDir.ToolTipText = folder 1588 End If 1589End Sub 1590 1591Private Sub btnBrowseDirOut_Click() 1592 Dim folder As String 1593 Dim StartDir As String 1594 1595 If Len(txtOutputDir.Text) > 0 Then 1596 StartDir = txtOutputDir.Text 1597 End If 1598 1599 folder = BrowseForFolder(Me, GetResString(BROWSE_FOR_RES_DIR_ID), StartDir) 1600 If Len(folder) = 0 Then 1601 Exit Sub 'User Selected Cancel 1602 End If 1603 txtOutputDir.Text = folder 1604 txtOutputDir.ToolTipText = folder 1605End Sub 1606 1607Private Sub btnPrepare_Click() 1608 On Error GoTo HandleErrors 1609 Dim currentFunctionName As String 1610 currentFunctionName = "btnPrepare_Click" 1611 1612 mbDoPrepare = True 1613 mbAllowExit = True 1614 1615 btnViewResults.Enabled = False 1616 btnRunAnalysis.Enabled = False 1617 btnPrepare.Enabled = False 1618 1619 cmdNav(BTN_CANCEL).Enabled = False 1620 cmdNav(BTN_BACK).Enabled = False 1621 cmdNav(BTN_NEXT).Enabled = False 1622 cmdNav(BTN_FINISH).Enabled = False 1623 btnPrepare.Caption = GetResString(RUNBTN_RUNNING_ID) 1624 1625 Dim str As String 1626 1627 If RunAnalysis(True) Then 1628 cmdNav(BTN_FINISH).Enabled = True 1629 btnRunAnalysis.Enabled = True 1630 btnViewResults.Enabled = True 1631 btnPrepare.Enabled = True 1632 btnViewResults.SetFocus 1633 str = ReplaceTopic2Tokens(GetResString(RID_STR_ENG_OTHER_PREPARE_COMPLETED_PREP_ID), _ 1634 TOPIC_STR, getOutputDir, CR_STR, Chr(13)) 1635 MsgBox str, vbInformation 1636 Else 1637 cmdNav(BTN_FINISH).Enabled = False 1638 btnRunAnalysis.Enabled = True 1639 btnViewResults.Enabled = False 1640 btnPrepare.Enabled = False 1641 End If 1642 1643FinalExit: 1644 mbDoPrepare = False 1645 cmdNav(BTN_CANCEL).Enabled = True 1646 cmdNav(BTN_BACK).Enabled = True 1647 cmdNav(BTN_NEXT).Enabled = False 1648 btnPrepare.Caption = GetResString(PREPAREBTN_START_ID) 1649 Exit Sub 1650 1651HandleErrors: 1652 cmdNav(BTN_FINISH).Enabled = False 1653 btnRunAnalysis.Enabled = True 1654 btnViewResults.Enabled = False 1655 btnPrepare.Enabled = False 1656 1657 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1658 Resume FinalExit 1659End Sub 1660 1661 1662Private Sub cmdNav_Click(Index As Integer) 1663 On Error GoTo HandleError 1664 Dim currentFunctionName As String 1665 currentFunctionName = "cmdNav_Click" 1666 Dim nAltStep As Integer 1667 Dim rc As Long 1668 Dim fso As Scripting.FileSystemObject 1669 1670 Select Case Index 1671 Case BTN_CANCEL 1672 'Copy backup configuration file over existing 1673 If fso Is Nothing Then 1674 Set fso = New Scripting.FileSystemObject 1675 End If 1676 If fso.FileExists(mIniFilePath & CCONFIG_BACKUP_EXT) Then 1677 DeleteFile mIniFilePath 1678 AttemptToCopyFile mIniFilePath & CCONFIG_BACKUP_EXT, mIniFilePath 1679 End If 1680 Set mDocFiles = Nothing 1681 1682 Unload Me 1683 1684 Case BTN_BACK 1685 nAltStep = mnCurStep - 1 1686 SetStep nAltStep, DIR_BACK 1687 1688 Case BTN_NEXT 1689 nAltStep = mnCurStep + 1 1690 SetStep nAltStep, DIR_NEXT 1691 1692 Case BTN_FINISH 1693 If (Not mbAllowExit) Then 1694 Dim str As String 1695 Dim response As Integer 1696 1697 str = ReplaceTopicTokens(GetResString(RID_STR_ENG_ANALYSE_NOT_RUN), CR_STR, Chr(13)) 1698 response = MsgBox(str, vbOKCancel + vbInformation) 1699 If response = vbOK Then ' User chose Ok. 1700 mbAllowExit = True 1701 End If 1702 End If 1703 1704 If (mbAllowExit) Then 1705 DeleteFile mIniFilePath & CCONFIG_BACKUP_EXT 1706 Set mDocFiles = Nothing 1707 Unload Me 1708 End If 1709 End Select 1710 1711FinalExit: 1712 Set fso = Nothing 1713 Exit Sub 1714 1715HandleError: 1716 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1717 1718 Resume FinalExit 1719End Sub 1720 1721Private Sub btnRunAnalysis_Click() 1722 On Error GoTo HandleErrors 1723 Dim bViewResults As Boolean 1724 Dim str As String 1725 Dim response As Integer 1726 1727 btnViewResults.Enabled = False 1728 btnRunAnalysis.Enabled = False 1729 btnPrepare.Enabled = False 1730 bViewResults = False 1731 mbAllowExit = True 1732 1733 cmdNav(BTN_CANCEL).Enabled = False 1734 cmdNav(BTN_BACK).Enabled = False 1735 cmdNav(BTN_NEXT).Enabled = False 1736 cmdNav(BTN_FINISH).Enabled = False 1737 btnRunAnalysis.Caption = GetResString(RUNBTN_RUNNING_ID) 1738 1739 If RunAnalysis(False) Then 1740 cmdNav(BTN_FINISH).Enabled = True 1741 btnRunAnalysis.Enabled = True 1742 btnViewResults.Enabled = True 1743 btnPrepare.Enabled = True 1744 btnViewResults.SetFocus 1745 btnRunAnalysis.Caption = GetResString(RUNBTN_START_ID) 1746 1747 str = ReplaceTopicTokens(GetResString(RID_STR_ENG_ANALYZE_COMPLETED_ID), CR_STR, Chr(13)) 1748 response = MsgBox(str, vbOKCancel + vbInformation) 1749 If response = vbOK Then ' User chose Ok. 1750 bViewResults = True 1751 End If 1752 Else 1753 btnRunAnalysis.Enabled = True 1754 btnViewResults.Enabled = False 1755 btnPrepare.Enabled = False 1756 End If 1757 1758FinalExit: 1759 cmdNav(BTN_CANCEL).Enabled = True 1760 cmdNav(BTN_BACK).Enabled = True 1761 cmdNav(BTN_NEXT).Enabled = False 1762 btnRunAnalysis.Caption = GetResString(RUNBTN_START_ID) 1763 1764 If bViewResults Then 1765 btnViewResults_Click 1766 End If 1767 1768 Exit Sub 1769 1770HandleErrors: 1771 cmdNav(BTN_FINISH).Enabled = False 1772 btnRunAnalysis.Enabled = True 1773 btnViewResults.Enabled = False 1774 btnPrepare.Enabled = False 1775 WriteDebug "Document Analysis: View Analysis Results" & Err.Number & " " & Err.Description & " " & Err.Source 1776 Resume FinalExit 1777End Sub 1778 1779Private Sub btnViewResults_Click() 1780 On Error GoTo HandleErrors 1781 Dim resultsFile As String 1782 Dim fso As New FileSystemObject 1783 Dim str As String 1784 1785 mbAllowExit = True 1786 1787 resultsFile = getOutputDir & "\" & txtResultsName.Text 1788 1789 If GetIniSetting(COUTPUT_TYPE) = COUTPUT_TYPE_XML Or _ 1790 GetIniSetting(COUTPUT_TYPE) = COUTPUT_TYPE_BOTH Then 1791 1792 Dim base As String 1793 Dim path As String 1794 base = fso.GetParentFolderName(resultsFile) & "\" & fso.GetBaseName(txtResultsName.Text) 1795 If CheckWordDocsToAnalyze Then 1796 path = base & "_" & CAPPNAME_WORD & "." & COUTPUT_TYPE_XML 1797 End If 1798 If CheckExcelDocsToAnalyze Then 1799 If path <> "" Then path = path & vbLf 1800 path = path & base & "_" & CAPPNAME_EXCEL & "." & COUTPUT_TYPE_XML 1801 End If 1802 If CheckPPDocsToAnalyze Then 1803 If path <> "" Then path = path & vbLf 1804 path = path & base & "_" & CAPPNAME_POWERPOINT & "." & COUTPUT_TYPE_XML 1805 End If 1806 1807 str = ReplaceTopic2Tokens(GetResString(XML_RESULTS_ID), _ 1808 TOPIC_STR, path, CR_STR, Chr(13)) 1809 WriteDebug str 1810 MsgBox str, vbInformation 1811 If GetIniSetting(COUTPUT_TYPE) = COUTPUT_TYPE_XML Then 1812 Resume FinalExit 1813 End If 1814 End If 1815 1816 If Not fso.FileExists(resultsFile) Then 1817 str = ReplaceTopic2Tokens(GetResString(ERR_MISSING_RESULTS_DOC), _ 1818 TOPIC_STR, resultsFile, CR_STR, Chr(13)) 1819 WriteDebug str 1820 MsgBox str, vbCritical 1821 Resume FinalExit 1822 End If 1823 1824 Dim xl As Excel.application 1825 Set xl = New Excel.application 1826 xl.Visible = True 1827 xl.Workbooks.Open resultsFile 1828 1829FinalExit: 1830 Set xl = Nothing 1831 Set fso = Nothing 1832 1833 Exit Sub 1834HandleErrors: 1835 WriteDebug "Document Analysis: View Analysis Results" & Err.Number & " " & Err.Description & " " & Err.Source 1836End Sub 1837 1838Private Sub Form_Activate() 1839 Dim currentFunctionName As String 1840 Dim missingFile As String 1841 currentFunctionName = "Form_Activate" 1842 On Error GoTo HandleErrors 1843 1844 If Not CheckNeededFiles(missingFile) Then 1845 Dim str As String 1846 str = ReplaceTopic2Tokens(GetResString(ERR_MISSING_WORD_DRIVER), _ 1847 TOPIC_STR, missingFile, CR_STR, Chr(13)) 1848 WriteDebug str 1849 MsgBox str, vbCritical 1850 1851 End 'Exit application - some needed files are missing 1852 End If 1853 1854FinalExit: 1855 Exit Sub 1856 1857HandleErrors: 1858 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1859 GoTo FinalExit 1860End Sub 1861 1862Private Sub Form_Initialize() 1863 Dim currentFunctionName As String 1864 currentFunctionName = "Form_Initialize" 1865 On Error GoTo ErrorHandler 1866 Call InitCommonControls 'Use Windows XP Visual Style 1867 1868FinalExit: 1869 Exit Sub 1870 1871ErrorHandler: 1872 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 1873 GoTo FinalExit 1874End Sub 1875 1876Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) 1877 If KeyCode = vbKeyF1 Then 1878 'cmdNav_Click BTN_HELP 1879 End If 1880End Sub 1881 1882Private Sub Form_Load() 1883 Const COS_CHECK = "oscheck" 1884 1885 On Error GoTo HandleErrors 1886 Dim currentFunctionName As String 1887 currentFunctionName = "Form_Load" 1888 1889 Dim fso As New FileSystemObject 1890 Dim i As Integer 1891 'init all vars 1892 mbFinishOK = False 1893 mbTrue = True 1894 mbFalse = False 1895 1896 mLogFilePath = GetLogFilePath 1897 mIniFilePath = GetIniFilePath 1898 mbDocCountCurrent = False 1899 mbDoPrepare = False 1900 mbAllowExit = False 1901 1902 'Check OS before running 1903 Dim bOSCheck As Boolean 1904 bOSCheck = IIf(GetIniSetting(COS_CHECK) = "False", False, True) 1905 1906 If bOSCheck Then 1907 If Not IsWin98Plus Then 1908 Dim str As String 1909 Dim winVer As RGB_WINVER 1910 str = ReplaceTopic2Tokens(GetResString(ERR_SUPPORTED_OSVERSION), _ 1911 TOPIC_STR, GetWinVersion(winVer), CR_STR, Chr(13)) 1912 WriteDebug str 1913 MsgBox str, vbCritical 1914 1915 End 'Exit application - unsupported OS 1916 End If 1917 Else 1918 Err.Clear 1919 WriteDebug "IsWin2000Plus OS Check bypassed by analysis.ini oscheck=False setting" 1920 End If 1921 1922 1923 For i = 0 To NUM_STEPS - 1 1924 fraStep(i).Left = -10000 1925 Next 1926 1927 'Load All string info for Form 1928 LoadResStrings Me 1929 1930 frmWizard.Caption = ReplaceTopicTokens(GetResString(TITLE_ID), CPRODUCTNAME_STR, _ 1931 GetResString(PRODUCTNAME_ID)) 1932 lblIntroduction1.Caption = ReplaceTopicTokens(GetResString(INTRO1_ID), CPRODUCTNAME_STR, _ 1933 GetResString(PRODUCTNAME_ID)) 1934 mLblSteps = GetResString(LBL_STEPS_ID) 1935 mChbSubdirs = GetResString(CHK_SUBDIRS_ID) 1936 1937 ' Setup Doc Preparation specific strings 1938 If gBoolPreparation Then 1939 ' Steps 1940 lblStep1_4.Caption = GetResString(RID_STR_ENG_SIDEBAR_ANALYZE_PREP_ID) 1941 lblStep2_4.Caption = GetResString(RID_STR_ENG_SIDEBAR_ANALYZE_PREP_ID) 1942 lblStep3_4.Caption = GetResString(RID_STR_ENG_SIDEBAR_ANALYZE_PREP_ID) 1943 lblStep4_4.Caption = GetResString(RID_STR_ENG_SIDEBAR_ANALYZE_PREP_ID) 1944 1945 ' Preparation - Step 1. Introduction 1946 lblIntroduction1.Caption = ReplaceTopicTokens(GetResString(RID_STR_ENG_INTRODUCTION_INTRO1_PREP_ID), CPRODUCTNAME_STR, _ 1947 GetResString(PRODUCTNAME_ID)) 1948 lblIntroduction2.Caption = GetResString(RID_STR_ENG_INTRODUCTION_INTRO2_PREP_ID) 1949 lblIntroduction3.Caption = GetResString(RID_STR_ENG_INTRODUCTION_INTRO3_PREP_ID) 1950 1951 ' Preparation - Step 2. Documents 1952 lblChooseDocs.Caption = GetResString(RID_STR_ENG_DOCUMENTS_CHOOSE_DOCUMENTS_PREP_ID) 1953 lblDocTypes.Caption = GetResString(RID_STR_ENG_DOCUMENTS_CHOOSE_DOC_TYPES_PREP_ID) 1954 'mChbSubdirs = GetResString(RID_STR_ENG_DOCUMENTS_INCLUDE_SUBDIRECTORIES_PREP_ID) 1955 chkIgnoreOld.Caption = GetResString(RID_STR_IGNORE_OLDER_CB_ID) 1956 1957 cbIgnoreOld.Clear 1958 cbIgnoreOld.AddItem (GetResString(RID_STR_IGNORE_OLDER_3_MONTHS_ID)) 1959 cbIgnoreOld.AddItem (GetResString(RID_STR_IGNORE_OLDER_6_MONTHS_ID)) 1960 cbIgnoreOld.AddItem (GetResString(RID_STR_IGNORE_OLDER_12_MONTHS_ID)) 1961 cbIgnoreOld.ListIndex = 0 1962 1963 ' Preparation - Step 3. Results 1964 lblChooseResults.Caption = GetResString(RID_STR_ENG_RESULTS_CHOOSE_OPTIONS_PREP_ID) 1965 txtResultsName.Text = GetResString(RID_STR_ENG_RESULTS_ANALYSIS_XLS_PREP_ID) 1966 1967 'Show Append option 1968 rdbResultsAppend.Visible = True 1969 1970 ' Preparation - Step 4. Analysis 1971 lblSetupDone.Caption = GetResString(RID_STR_ENG_ANALYZE_SETUP_COMPLETE_PREP_ID) 1972 btnPrepare.Visible = True 1973 Else 1974 ' The next line is a work around for a wrong translated string and should be removed 1975 ' when RID_STR_ENG_RESULTS_CHOOSE_OPTIONS has been corrected 1976 lblChooseResults.Caption = GetResString(RID_STR_ENG_RESULTS_CHOOSE_OPTIONS_PREP_ID) 1977 mDefaultPassword = IIf(GetIniSetting(CDEFAULT_PASSWORD) = "", _ 1978 CSTR_TEST_PASSWORD, GetIniSetting(CDEFAULT_PASSWORD)) 1979 End If 1980 1981 SetStep 0, DIR_NEXT 1982 Dim tmpStr As String 1983 1984 'Setup Params 1985 tmpStr = GetIniSetting(CINPUT_DIR) 1986 If tmpStr <> "" Then 1987 txtInputDir.Text = tmpStr 1988 txtInputDir.ToolTipText = tmpStr 1989 End If 1990 tmpStr = GetIniSetting(COUTPUT_DIR) 1991 If tmpStr <> "" Then 1992 If Right(tmpStr, 1) = ":" And Len(tmpStr) = 2 Then 1993 tmpStr = tmpStr & "\" 1994 End If 1995 txtOutputDir.Text = tmpStr 1996 txtOutputDir.ToolTipText = tmpStr 1997 End If 1998 tmpStr = GetIniSetting(CRESULTS_FILE) 1999 If tmpStr <> "" Then txtResultsName.Text = tmpStr 2000 2001 rdbResultsPrompt.value = False 2002 rdbResultsOverwrite.value = False 2003 rdbResultsAppend.value = False 2004 Dim resultsSetting As String 2005 resultsSetting = GetIniSetting(CRESULTS_EXIST) 2006 If resultsSetting = CPROMPT_FILE Then 2007 rdbResultsPrompt.value = True 2008 ElseIf resultsSetting = CAPPEND_FILE Then 2009 rdbResultsAppend.value = True 2010 Else 2011 rdbResultsOverwrite.value = True 2012 End If 2013 2014 chkWordDoc.value = IIf(GetIniSetting(CTYPE_WORDDOC) = CStr(True), vbChecked, 0) 2015 chkWordTemplate.value = IIf(GetIniSetting(CTYPE_WORDDOT) = CStr(True), vbChecked, 0) 2016 chkExcelDoc.value = IIf(GetIniSetting(CTYPE_EXCELDOC) = CStr(True), vbChecked, 0) 2017 chkExcelTemplate.value = IIf(GetIniSetting(CTYPE_EXCELDOT) = CStr(True), vbChecked, 0) 2018 chkPPDoc.value = IIf(GetIniSetting(CTYPE_PPDOC) = CStr(True), vbChecked, 0) 2019 chkPPTemplate.value = IIf(GetIniSetting(CTYPE_PPDOT) = CStr(True), vbChecked, 0) 2020 chkIncludeSubdirs.value = IIf(GetIniSetting(CINCLUDE_SUBDIRS) = CStr(True), vbChecked, 0) 2021 mDebugLevel = IIf(GetIniSetting(CDEBUG_LEVEL) = "", CDEBUG_LEVEL_DEFAULT, GetIniSetting(CDEBUG_LEVEL)) 2022 chkIgnoreOld.value = IIf(GetIniSetting(CIGNORE_OLD_DOCS) = CStr(True), vbChecked, 0) 2023 2024 mIssueLimit = IIf(GetIniSetting(CISSUE_LIMIT) = "", CISSUE_LIMIT_DAW, GetIniSetting(CISSUE_LIMIT)) 2025 If (mIssueLimit <= 3) Then 2026 cbIgnoreOld.ListIndex = 0 2027 ElseIf (mIssueLimit <= 6) Then 2028 cbIgnoreOld.ListIndex = 1 2029 Else 2030 cbIgnoreOld.ListIndex = 2 2031 End If 2032 2033 'Always ensure at least one doc type is selected on startup 2034 If (chkWordDoc.value <> vbChecked) And _ 2035 (chkWordTemplate.value <> vbChecked) And _ 2036 (chkExcelDoc.value <> vbChecked) And _ 2037 (chkExcelTemplate.value <> vbChecked) And _ 2038 (chkPPDoc.value <> vbChecked) And _ 2039 (chkPPTemplate.value <> vbChecked) Then 2040 2041 chkWordDoc.value = vbChecked 2042 End If 2043 2044FinalExit: 2045 Set fso = Nothing 2046 Exit Sub 2047 2048HandleErrors: 2049 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 2050 Resume FinalExit 2051End Sub 2052 2053Private Sub SetStep(nStep As Integer, nDirection As Integer) 2054 On Error GoTo HandleError 2055 Const driveTypeIsCDROM = 4 2056 Dim val As String 2057 Dim fso As Scripting.FileSystemObject 2058 Set fso = New Scripting.FileSystemObject 2059 Dim drive 2060 2061 2062 mbDocCountCurrent = False 2063 2064 Select Case nStep 2065 Case STEP_INTRO 2066 'MsgBox "Enter Intro" 2067 Case STEP_1 2068 'Leave Introduction 2069 'Workaround - resource bug for SubDir checkbox, have to set it explicitly 2070 chkIncludeSubdirs.Caption = mChbSubdirs 2071 Case STEP_2 2072 'Leave Documents 2073 2074 Set drive = fso.GetDrive(fso.GetDriveName(txtInputDir.Text)) 2075 If drive.DriveType = driveTypeIsCDROM Then 2076 If Not drive.IsReady Then 2077 MsgBox GetResString(ERR_CDROM_NOT_READY), vbCritical 2078 Exit Sub 2079 End If 2080 End If 2081 2082 If txtInputDir.Text = "" Or Not fso.FolderExists(txtInputDir.Text) Then ' fso.FolderExists() has replaced dir() 2083 MsgBox ReplaceTopicTokens(GetResString(ERR_NO_DOC_DIR), _ 2084 CR_STR, Chr(13)), vbCritical 2085 Exit Sub 2086 End If 2087 2088 If Not CheckUserChosenDocsToAnalyze Then 2089 MsgBox GetResString(ERR_NO_DOC_TYPES), vbCritical 2090 Exit Sub 2091 End If 2092 'Expand directory name only without path to full path 2093 txtInputDir.Text = fso.GetAbsolutePathName(txtInputDir.Text) 2094 2095 If txtOutputDir.Text = "" Then 2096 txtOutputDir.Text = txtInputDir.Text 2097 End If 2098 2099 mbFinishOK = False 2100 2101 'Workaround - label resource bug for Steps, have to set it explicitly 2102 Label12(0).Caption = mLblSteps 2103 Label12(5).Caption = mLblSteps 2104 Case STEP_FINISH 2105 'Leave Results 2106 If Not CheckResultsDir(getOutputDir) Then 2107 Exit Sub 2108 End If 2109 2110 'Expand directory name only without path to full path 2111 txtOutputDir.Text = fso.GetAbsolutePathName(txtOutputDir) 2112 2113 'Check Results file is there and has a valid extension 2114 If fso.GetBaseName(txtResultsName.Text) = "" Then 2115 txtResultsName.Text = GetResString(SETUP_ANALYSIS_XLS_ID) 2116 End If 2117 txtResultsName.Text = fso.GetBaseName(txtResultsName.Text) & CRESULTS_FILE_EXTENSION 2118 2119 Screen.MousePointer = vbHourglass 2120 DeleteFile mLogFilePath 2121 Set mDocFiles = Nothing 2122 If Not CheckNumberDocsToAnalyze Then 2123 Screen.MousePointer = vbDefault 2124 Exit Sub 2125 End If 2126 2127 Screen.MousePointer = vbDefault 2128 2129 btnRunAnalysis.Enabled = True 2130 2131 If GetNumberOfDocsToAnalyze = 0 Then 2132 btnRunAnalysis.Enabled = False 2133 End If 2134 2135 'Backup configuration 2136 If Not AttemptToCopyFile(mIniFilePath, mIniFilePath & CCONFIG_BACKUP_EXT) Then 2137 Exit Sub 2138 End If 2139 2140 'Save current Wizard Settings 2141 WriteWizardSettingsToLog mIniFilePath 2142 2143 'If results file already exists, enable View and Prepare 2144 If fso.FileExists(getOutputDir & "\" & txtResultsName.Text) Then 2145 btnViewResults.Enabled = True 2146 btnPrepare.Enabled = True 2147 End If 2148 2149 mbFinishOK = True 2150 End Select 2151 2152 'move to new step 2153 fraStep(mnCurStep).Enabled = False 2154 fraStep(nStep).Left = 0 2155 If nStep <> mnCurStep Then 2156 fraStep(mnCurStep).Left = -10000 2157 fraStep(mnCurStep).Enabled = False 2158 End If 2159 fraStep(nStep).Enabled = True 2160 2161 SetNavBtns nStep 2162 Exit Sub 2163 2164FinalExit: 2165 Set fso = Nothing 2166 Set drive = Nothing 2167 Exit Sub 2168 2169HandleError: 2170 Screen.MousePointer = vbDefault 2171 WriteDebug "Document Analysis: SetStep() " & Err.Number & " " & Err.Description & " " & Err.Source 2172 2173 Resume FinalExit 2174End Sub 2175 2176Function CheckResultsDir(resultsDir As String) As Boolean 2177 On Error GoTo HandleError 2178 Dim fso As Scripting.FileSystemObject 2179 Set fso = New Scripting.FileSystemObject 2180 Const driveTypeIsCDROM = 4 2181 Const readOnlyFolderRemainder = 1 2182 Dim drive 2183 CheckResultsDir = False 2184 2185 If resultsDir = "" Then 2186 MsgBox ReplaceTopicTokens(GetResString(ERR_NO_RESULTS_DIRECTORY), _ 2187 CR_STR, Chr(13)), vbCritical 2188 CheckResultsDir = False 2189 Exit Function 2190 End If 2191 2192 Set drive = fso.GetDrive(fso.GetDriveName(resultsDir)) 2193 If drive.DriveType = driveTypeIsCDROM Then 'If CD-ROM Drive Then 2194 Dim Msg1 As String 2195 Msg1 = ReplaceTopic2Tokens(GetResString(ERR_CREATE_FILE), _ 2196 TOPIC_STR, txtResultsName.Text, CR_STR, Chr(13)) 2197 MsgBox Msg1, vbCritical 2198 CheckResultsDir = False 2199 Exit Function 2200 End If 2201 2202 2203 If Not fso.FolderExists(resultsDir) Then 2204 Dim Msg, Style, response 2205 2206 Msg = ReplaceTopicTokens(GetResString(ERR_NO_RES_DIR), CR_STR, Chr(13)) 2207 Style = vbYesNo + vbQuestion + vbDefaultButton1 ' Define buttons. 2208 2209 response = MsgBox(Msg, Style) 2210 If response = vbYes Then ' User chose Yes. 2211 If Not CreateDir(getOutputDir) Then 2212 CheckResultsDir = False 2213 Exit Function 2214 End If 2215 Else ' User chose No. 2216 CheckResultsDir = False 2217 Exit Function 2218 End If 2219 End If 2220 2221 Dim testFile As String 2222 testFile = resultsDir & "\" & fso.GetTempName 2223 Do While fso.FileExists(testFile) 2224 testFile = resultsDir & "\" & fso.GetTempName 2225 Loop 2226 2227 On Error GoTo HandleReadOnly 2228 Dim aText As TextStream 2229 Set aText = fso.CreateTextFile(testFile, False, False) 2230 aText.WriteLine ("Dies ist ein Test.") 2231 aText.Close 2232 fso.DeleteFile (testFile) 2233 2234' GetAttr doesn't work reliable ( returns read only for 'my Documents' and rw for read only network folder 2235' If ((GetAttr(resultsDir) Mod 2) = readOnlyFolderRemainder) Then 'If the attribute is odd then the folder is read-only 2236' MsgBox GetResString(ERR_NO_WRITE_TO_READ_ONLY_FOLDER), vbCritical 2237' CheckResultsDir = False 2238' Exit Function 2239' End If 2240 2241 CheckResultsDir = True 2242 2243 Exit Function 2244HandleError: 2245 WriteDebug "Document Analysis: CheckResultsDir() " & Err.Number & " " & Err.Description & " " & Err.Source 2246 CheckResultsDir = False 2247 Exit Function 2248HandleReadOnly: 2249 Dim str As String 2250 str = ReplaceTopic2Tokens(GetResString(ERR_CREATE_FILE), _ 2251 TOPIC_STR, txtResultsName.Text, CR_STR, Chr(13)) 2252 MsgBox str, vbCritical 2253 CheckResultsDir = False 2254 Exit Function 2255End Function 2256 2257Function CheckUserChosenDocsToAnalyze() As Boolean 2258 CheckUserChosenDocsToAnalyze = Not ((chkWordDoc.value <> vbChecked) And (chkWordTemplate.value <> vbChecked) And _ 2259 (chkExcelDoc.value <> vbChecked) And (chkExcelTemplate.value <> vbChecked) And _ 2260 (chkPPDoc.value <> vbChecked) And (chkPPTemplate.value <> vbChecked)) 2261End Function 2262 2263Function AttemptToCopyFile(Source As String, dest As String) As Boolean 2264 On Error GoTo HandleErrors 2265 Dim fso As Scripting.FileSystemObject 2266 Set fso = New Scripting.FileSystemObject 2267 2268 If fso.FileExists(Source) Then 2269 fso.CopyFile Source, dest 2270 End If 2271 2272 'True if no source or copy succeded 2273 AttemptToCopyFile = True 2274 2275FinalExit: 2276 Set fso = Nothing 2277 Exit Function 2278 2279HandleErrors: 2280 AttemptToCopyFile = False 2281 Dim str As String 2282 str = ReplaceTopic2Tokens(GetResString(ERR_CREATE_FILE), _ 2283 TOPIC_STR, mIniFilePath & CCONFIG_BACKUP_EXT, CR_STR, Chr(13)) 2284 Resume FinalExit 2285 2286End Function 2287 2288Function CreateDir(dir As String) As Boolean 2289 On Error GoTo HandleErrors 2290 Dim fso As Scripting.FileSystemObject 2291 Set fso = New Scripting.FileSystemObject 2292 2293 fso.CreateFolder (dir) 2294 2295 CreateDir = True 2296 2297FinalExit: 2298 Set fso = Nothing 2299 Exit Function 2300 2301HandleErrors: 2302 Dim str As String 2303 str = ReplaceTopic2Tokens(GetResString(ERR_CREATE_DIR), _ 2304 TOPIC_STR, dir, CR_STR, Chr(13)) 2305 Select Case Err.Number 2306 Case 76 2307 WriteDebug str 2308 MsgBox str, vbCritical 2309 CreateDir = False 2310 Case 58 2311 'Don't care if it exists already 2312 CreateDir = True 2313 Case Else 2314 WriteDebug str 2315 MsgBox str, vbCritical 2316 CreateDir = False 2317 End Select 2318 Resume FinalExit 2319 2320End Function 2321Private Sub SetNavBtns(nStep As Integer) 2322 mnCurStep = nStep 2323 2324 If mnCurStep = 0 Then 2325 cmdNav(BTN_BACK).Enabled = False 2326 cmdNav(BTN_NEXT).Enabled = True 2327 ElseIf mnCurStep = NUM_STEPS - 1 Then 2328 cmdNav(BTN_NEXT).Enabled = False 2329 cmdNav(BTN_BACK).Enabled = True 2330 Else 2331 cmdNav(BTN_BACK).Enabled = True 2332 cmdNav(BTN_NEXT).Enabled = True 2333 End If 2334 2335 If mbFinishOK Then 2336 cmdNav(BTN_FINISH).Enabled = True 2337 Else 2338 cmdNav(BTN_FINISH).Enabled = False 2339 End If 2340End Sub 2341Function CheckForSupportedApp(app As String, lowerVerLimit As Long) As Boolean 2342 Dim appRegStr As String 2343 Dim appVer As Long 2344 appRegStr = GetRegistryInfo(HKEY_CLASSES_ROOT, app & ".Application\CurVer", "") 2345 appVer = val(Right(appRegStr, Len(appRegStr) - Len(app & ".Application."))) 2346 If appVer >= lowerVerLimit Then 2347 CheckForSupportedApp = True 2348 Else 2349 CheckForSupportedApp = False 2350 End If 2351End Function 2352Function GetAppVersion(app As String) As Long 2353 Dim appRegStr As String 2354 Dim appVer As Long 2355 appRegStr = GetRegistryInfo(HKEY_CLASSES_ROOT, app & ".Application\CurVer", "") 2356 GetAppVersion = val(Right(appRegStr, Len(appRegStr) - Len(app & ".Application."))) 2357End Function 2358Function GetInstalledApp(app As String) As String 2359 GetInstalledApp = GetRegistryInfo(HKEY_CLASSES_ROOT, app & ".Application\CurVer", "") 2360End Function 2361 2362Sub WriteInfoToApplicationLog(wordAppStr As String, excelAppStr As String, ppAppStr As String) 2363 On Error GoTo HandleErrors 2364 Dim currentFunctionName As String 2365 currentFunctionName = "WriteInfoToApplicationLog" 2366 2367 Dim userLCID As Long 2368 userLCID = GetUserDefaultLCID() 2369 Dim sysLCID As Long 2370 sysLCID = GetSystemDefaultLCID() 2371 2372 WriteToLog CWORD_VERSION, IIf(wordAppStr <> "", wordAppStr, CNOT_INSTALLED) 2373 WriteToLog CEXCEL_VERSION, IIf(excelAppStr <> "", excelAppStr, CNOT_INSTALLED) 2374 WriteToLog CPOWERPOINT_VERSION, IIf(ppAppStr <> "", ppAppStr, CNOT_INSTALLED) 2375 2376 WriteToLog CUSER_LOCALE_INFO, _ 2377 "langid: " & GetUserLocaleInfo(userLCID, LOCALE_ILANGUAGE) & ": " & _ 2378 GetUserLocaleInfo(userLCID, LOCALE_SENGLANGUAGE) & _ 2379 "-" & GetUserLocaleInfo(userLCID, LOCALE_SENGCOUNTRY) & _ 2380 " abrv: " & GetUserLocaleInfo(userLCID, LOCALE_SISO639LANGNAME) & _ 2381 "-" & GetUserLocaleInfo(userLCID, LOCALE_SISO3166CTRYNAME) & _ 2382 " sdate: " & GetUserLocaleInfo(userLCID, LOCALE_SSHORTDATE) 2383 2384 WriteToLog CSYS_LOCALE_INFO, _ 2385 "langid: " & GetUserLocaleInfo(sysLCID, LOCALE_ILANGUAGE) & ": " & _ 2386 GetUserLocaleInfo(sysLCID, LOCALE_SENGLANGUAGE) & _ 2387 "-" & GetUserLocaleInfo(sysLCID, LOCALE_SENGCOUNTRY) & _ 2388 " abrv: " & GetUserLocaleInfo(sysLCID, LOCALE_SISO639LANGNAME) & _ 2389 "-" & GetUserLocaleInfo(sysLCID, LOCALE_SISO3166CTRYNAME) & _ 2390 " sdate: " & GetUserLocaleInfo(userLCID, LOCALE_SSHORTDATE) 2391 2392 Dim myWinVer As RGB_WINVER 2393 GetWinVersion myWinVer 2394 WriteToLog CWINVERSION, myWinVer.VersionName & " " & myWinVer.VersionNo & _ 2395 " " & myWinVer.ServicePack & _ 2396 " build " & myWinVer.BuildNo 2397 WriteToLog CNUMBER_TOTAL_DOCS, CStr(mTotalDocCount) 2398 WriteToLog CNUMBER_DOCS_DOC, CStr(mWordDocCount) 2399 WriteToLog CNUMBER_TEMPLATES_DOT, CStr(mWordTemplateCount) 2400 WriteToLog CNUMBER_DOCS_XLS, CStr(mExcelDocCount) 2401 WriteToLog CNUMBER_TEMPLATES_XLT, CStr(mExcelTemplateCount) 2402 WriteToLog CNUMBER_DOCS_PPT, CStr(mPPDocCount) 2403 WriteToLog CNUMBER_TEMPLATES_POT, CStr(mPPTemplateCount) 2404FinalExit: 2405 Exit Sub 2406 2407HandleErrors: 2408 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 2409 Resume FinalExit 2410End Sub 2411 2412Function CheckTemplatePath(sMigrationResultsTemplatePath As String, fso As FileSystemObject) As Boolean 2413 If Not fso.FileExists(sMigrationResultsTemplatePath) Then 2414 Dim str As String 2415 str = ReplaceTopic2Tokens(GetResString(ERR_MISSING_RESULTS_TEMPLATE), _ 2416 TOPIC_STR, sMigrationResultsTemplatePath, CR_STR, Chr(13)) 2417 WriteDebug str 2418 MsgBox str, vbCritical 2419 CheckTemplatePath = False 2420 Else 2421 CheckTemplatePath = True 2422 End If 2423End Function 2424 2425Function RunAnalysis(bDoPrepare) As Boolean 2426 On Error GoTo HandleErrors 2427 Dim currentFunctionName As String 2428 currentFunctionName = "RunAnalysis" 2429 Dim tstart As Single 'timer var for this routine only 2430 Dim tend As Single 'timer var for this routine only 2431 Dim fso As New FileSystemObject 2432 Dim wordAppStr As String 2433 Dim excelAppStr As String 2434 Dim ppAppStr As String 2435 Dim sMigrationResultsTemplatePath As String 2436 Dim startDate As Variant 2437 Dim bSuccess 2438 2439 bSuccess = True 2440 startDate = Now 2441 tstart = GetTickCount() 2442 2443 app.OleRequestPendingMsgText = GetResString(RUNBTN_RUNNING_ID) 2444 app.OleRequestPendingMsgTitle = frmWizard.Caption 2445 2446 wordAppStr = GetInstalledApp(CAPPNAME_WORD) 2447 excelAppStr = GetInstalledApp(CAPPNAME_EXCEL) 2448 ppAppStr = GetInstalledApp(CAPPNAME_POWERPOINT) 2449 'Write locale, version info and settings to the Application log 2450 WriteInfoToApplicationLog wordAppStr, excelAppStr, ppAppStr 2451 2452 'Check for template 2453 sMigrationResultsTemplatePath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CRESULTS_TEMPLATE_FILE) 2454 If Not CheckTemplatePath(sMigrationResultsTemplatePath, fso) Then 2455 bSuccess = False 2456 GoTo FinalExit 2457 End If 2458 2459 'Check for installed Apps 2460 If Not CheckInstalledApps(wordAppStr, excelAppStr, ppAppStr) Then 2461 bSuccess = False 2462 GoTo FinalExit 2463 End If 2464 2465 If bDoPrepare Then 2466 'Show MsgBox ( to give apps some time to quit ) 2467 Dim strMsgBox As String 2468 Dim response As Integer 2469 2470 strMsgBox = ReplaceTopic2Tokens(GetResString(RID_STR_ENG_OTHER_PREPARE_PROMPT_PREP_ID), _ 2471 TOPIC_STR, getOutputDir & "\" & txtResultsName.Text, TOPIC2_STR, getOutputDir) 2472 strMsgBox = ReplaceTopicTokens(strMsgBox, CR_STR, Chr(13)) 2473 response = MsgBox(strMsgBox, Buttons:=vbOKCancel + vbInformation) 2474 2475 If response <> vbOK Then 2476 bSuccess = False 2477 GoTo FinalExit 2478 End If 2479 End If 2480 2481 'Write Wizard Setting to Application log 2482 WriteWizardSettingsToLog mLogFilePath 2483 2484 'Write to Analysis ini file - used by driver docs 2485 WriteCommonParamsToLog sMigrationResultsTemplatePath, mLogFilePath, mIniFilePath, fso 2486 2487 Screen.MousePointer = vbHourglass 2488 ' Doc Counts are setup by CheckNumberDocsToAnalyze() when user moves to Analysis Panel 2489 ' Takes account of user Options selected and inspects source directory 2490 Dim analysisAborted As Boolean 2491 analysisAborted = False 2492 2493 SetupInputVariables mLogFilePath, fso 2494 2495 Load ShowProgress 2496 Call ShowProgress.SP_Init(mDocFiles.WordFiles.count + _ 2497 mDocFiles.ExcelFiles.count + _ 2498 mDocFiles.PowerPointFiles.count) 2499 2500 Dim myOffset As Long 2501 myOffset = 0 2502 If (mDocFiles.WordFiles.count > 0) Then 2503 bSuccess = AnalyseList(mDocFiles.WordFiles, "word", mIniFilePath, myOffset, analysisAborted) 2504 'bSuccess = RunWordAnalysis(sMigrationResultsTemplatePath, mLogFilePath, fso) 2505 End If 2506 2507 myOffset = mDocFiles.WordFiles.count 2508 If ((mDocFiles.ExcelFiles.count > 0) And (Not analysisAborted)) Then 2509 bSuccess = bSuccess And _ 2510 AnalyseList(mDocFiles.ExcelFiles, "excel", mIniFilePath, myOffset, analysisAborted) 2511 'bSuccess = RunExcelAnalysis(sMigrationResultsTemplatePath, mLogFilePath, fso) 2512 End If 2513 2514 myOffset = myOffset + mDocFiles.ExcelFiles.count 2515 If ((mDocFiles.PowerPointFiles.count > 0) And (Not analysisAborted)) Then 2516 bSuccess = bSuccess And _ 2517 AnalyseList(mDocFiles.PowerPointFiles, "pp", mIniFilePath, myOffset, analysisAborted) 2518 'bSuccess = RunPPAnalysis(sMigrationResultsTemplatePath, mLogFilePath, fso) 2519 End If 2520 2521 SetupInputVariables mLogFilePath, fso 2522 2523 tend = GetTickCount() 2524 WriteToLog CELAPSED_TIME, (FormatNumber((tend - tstart) / 1000, 0) & " seconds: ") & _ 2525 (FormatNumber((tend - tstart), 0) & " miliseconds") 2526 2527FinalExit: 2528 Unload ShowProgress 2529 Screen.MousePointer = vbDefault 2530 WriteToLog CSTART_TIME, CDate(startDate) 2531 WriteToLog CEND_TIME, Now 2532 Set fso = Nothing 2533 2534 RunAnalysis = bSuccess 2535 Exit Function 2536 2537HandleErrors: 2538 bSuccess = False 2539 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 2540 Resume FinalExit 2541End Function 2542 2543Function CheckInstalledApps(wordAppStr As String, excelAppStr As String, ppAppStr As String) As Boolean 2544 On Error GoTo HandleErrors 2545 Dim currentFunctionName As String 2546 Dim str As String 2547 currentFunctionName = "CheckInstalledApps" 2548 2549 Dim missingInstalledApps As String 2550 Dim unsupportedApps As String 2551 Dim runningApps As String 2552 Dim bSuccess As Boolean 2553 2554 bSuccess = False 2555 2556 If mWordDocCount > 0 Or mWordTemplateCount > 0 Then 2557 If wordAppStr = "" Then 'Word not installed 2558 missingInstalledApps = CAPPNAME_WORD 2559 ElseIf Not CheckForSupportedApp(CAPPNAME_WORD, CSUPPORTED_VERSION) Then 2560 unsupportedApps = CAPPNAME_WORD 2561 ElseIf IsOfficeAppRunning(CAPPNAME_WORD) Then 2562 runningApps = CAPPNAME_WORD 2563 End If 2564 End If 2565 2566 If excelAppStr = "" Then 2567 If missingInstalledApps <> "" Then missingInstalledApps = missingInstalledApps & ", " 2568 missingInstalledApps = missingInstalledApps & CAPPNAME_EXCEL 2569 ElseIf Not CheckForSupportedApp(CAPPNAME_EXCEL, CSUPPORTED_VERSION) Then 2570 If unsupportedApps <> "" Then unsupportedApps = unsupportedApps & ", " 2571 unsupportedApps = unsupportedApps & CAPPNAME_EXCEL 2572 ElseIf IsOfficeAppRunning(CAPPNAME_EXCEL) Then 2573 If runningApps <> "" Then runningApps = runningApps & ", " 2574 runningApps = runningApps & CAPPNAME_EXCEL 2575 End If 2576 2577 If mPPDocCount > 0 Or mPPTemplateCount > 0 Then 2578 If ppAppStr = "" Then 'PP not installed 2579 If missingInstalledApps <> "" Then missingInstalledApps = missingInstalledApps & ", " 2580 missingInstalledApps = missingInstalledApps & CAPPNAME_POWERPOINT 2581 ElseIf Not CheckForSupportedApp(CAPPNAME_POWERPOINT, CSUPPORTED_VERSION) Then 2582 If unsupportedApps <> "" Then unsupportedApps = unsupportedApps & ", " 2583 unsupportedApps = unsupportedApps & CAPPNAME_POWERPOINT 2584 ElseIf IsOfficeAppRunning(CAPPNAME_POWERPOINT) Then 2585 If runningApps <> "" Then runningApps = runningApps & ", " 2586 runningApps = runningApps & CAPPNAME_POWERPOINT 2587 End If 2588 End If 2589 2590 If missingInstalledApps <> "" Then 2591 str = ReplaceTopic2Tokens(GetResString(ERR_NOT_INSTALLED), _ 2592 TOPIC_STR, missingInstalledApps, CR_STR, Chr(13)) 2593 WriteDebug str 2594 MsgBox str, vbCritical 2595 GoTo FinalExit 2596 End If 2597 2598 If unsupportedApps <> "" Then 2599 str = ReplaceTopic2Tokens(GetResString(ERR_SUPPORTED_VERSION), _ 2600 TOPIC_STR, unsupportedApps, CR_STR, Chr(13)) 2601 WriteDebug str 2602 MsgBox str, vbCritical 2603 GoTo FinalExit 2604 End If 2605 2606 If runningApps <> "" Then 2607 str = ReplaceTopic2Tokens(GetResString(ERR_APPLICATION_IN_USE), _ 2608 TOPIC_STR, runningApps, CR_STR, Chr(13)) 2609 WriteDebug str 2610 MsgBox str, vbCritical 2611 GoTo FinalExit 2612 End If 2613 2614 'Check for Excel automation server 2615 If CheckForExcel Then 2616 str = ReplaceTopicTokens(GetResString(ERR_EXCEL_OPEN), _ 2617 CR_STR, Chr(13)) 2618 WriteDebug str 2619 MsgBox str, vbCritical 2620 bSuccess = False 2621 GoTo FinalExit 2622 End If 2623 2624 bSuccess = True 2625 2626FinalExit: 2627 CheckInstalledApps = bSuccess 2628 Exit Function 2629 2630HandleErrors: 2631 bSuccess = False 2632 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 2633 Resume FinalExit 2634End Function 2635 2636Function RunPPAnalysis(resultsTemplate As String, logFile As String, fsObject As FileSystemObject) As Boolean 2637'DV: do we need this? get some error handling ideas here 2638 On Error GoTo HandleErrors 2639 Dim currentFunctionName As String 2640 currentFunctionName = "RunPPAnalysis" 2641 Const APP_PP = "PowerPoint" 2642 Dim str As String 2643 Dim bSuccess 2644 bSuccess = False 2645 2646 If (chkPPDoc.value <> vbChecked) And (chkPPTemplate.value <> vbChecked) Then 2647 RunPPAnalysis = True 2648 Exit Function 2649 End If 2650 2651 Dim sPPDriverDocPath As String 2652 2653 sPPDriverDocPath = fsObject.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CPP_DRIVER_FILE) 2654 If Not fsObject.FileExists(sPPDriverDocPath) Then 2655 str = ReplaceTopic2Tokens(GetResString(ERR_MISSING_PP_DRIVER), _ 2656 TOPIC_STR, sPPDriverDocPath, CR_STR, Chr(13)) 2657 WriteDebug str 2658 MsgBox str, vbCritical 2659 bSuccess = False 2660 GoTo FinalExit 2661 End If 2662 2663 Dim pp As PowerPoint.application 2664 Dim po As Object 2665 Dim aPres As PowerPoint.Presentation 2666 Dim RegValue As Long 2667 Set po = GetObject(sPPDriverDocPath) 2668 Set pp = po.application 2669 2670 If val(pp.Version) < CSUPPORTED_VERSION Then 2671 str = ReplaceTopic2Tokens(GetResString(ERR_SUPPORTED_VERSION), _ 2672 TOPIC_STR, pp.Version, CR_STR, Chr(13)) 2673 WriteDebug str 2674 MsgBox str, vbCritical 2675 bSuccess = False 2676 GoTo FinalExit 2677 End If 2678 2679 If Not CheckForAccesToPPVBProject(pp, aPres) Then 2680 RegValue = -1 2681 If Not GiveAccessToMacroProject(APP_PP, pp.Version, RegValue) Then 2682 Dim Style, response 2683 str = ReplaceTopic2Tokens(GetResString(ERR_NO_ACCESS_TO_VBPROJECT), _ 2684 TOPIC_STR, CAPPNAME_POWERPOINT, CR_STR, Chr(13)) 2685 WriteDebug str 2686 Style = vbYesNo + vbQuestion + vbDefaultButton1 2687 2688 response = MsgBox(str, Style) 2689 If response <> vbYes Then 2690 bSuccess = False 2691 GoTo FinalExit 2692 End If 2693 End If 2694 End If 2695 2696 Set aPres = pp.Presentations(1) 2697 Dim ppSlideHidden As PowerPoint.Slide 2698 Set ppSlideHidden = aPres.Slides(2) 2699 2700 'Setup Input Variables 2701 'SetupInputVariables resultsTemplate, logFile, fsObject, CAPPNAME_POWERPOINT 2702 2703 'Run PowerPoint Analysis 2704 pp.Run (fsObject.GetFileName(CBASE_RESOURCE_DIR & "\" & CPP_DRIVER_FILE) & "!AnalysisDriver.AnalyseDirectory") 2705 2706 bSuccess = True 2707 2708FinalExit: 2709 'Cannot seem to close it down from VB 2710 'Workaround is to close it in macro 2711 ' 2712 'If Not aPres Is Nothing Then 2713 ' aPres.Saved = msoTrue 2714 'End If 2715 'If Not pp Is Nothing Then pp.Quit 2716 2717 'Swallow error as we are closing down PP from macro 2718 'Does not seem to be possible to close it down from VB 2719 On Error Resume Next 2720 If RegValue <> -1 Then 2721 SetDefaultRegValue APP_PP, pp.Version, RegValue 2722 End If 2723 If RegValue = 0 Then 2724 DeleteRegValue APP_PP, pp.Version 2725 End If 2726 2727 If Not pp Is Nothing Then 2728 pp.Run (fsObject.GetFileName(CBASE_RESOURCE_DIR & "\" & CPP_DRIVER_FILE) & "!ApplicationSpecific.QuitPowerPoint") 2729 End If 2730 2731 2732 Set aPres = Nothing 2733 Set pp = Nothing 2734 Set po = Nothing 2735 2736 RunPPAnalysis = bSuccess 2737 Exit Function 2738 2739HandleErrors: 2740 bSuccess = False 2741 Set pp = Nothing 2742 Dim failedDoc As String 2743 2744 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 2745 2746 failedDoc = GetDebug(CAPPNAME_POWERPOINT, CANALYZING) 2747 If failedDoc = "" Or failedDoc = CSTR_ANALYSIS_LOG_DONE Then 2748 str = ReplaceTopic2Tokens(GetResString(ERR_AUTOMATION_FAILURE), _ 2749 TOPIC_STR, CAPPNAME_POWERPOINT, CR_STR, Chr(13)) 2750 Else 2751 str = ReplaceTopic2Tokens(GetResString(ERR_PP_DRIVER_CRASH), _ 2752 TOPIC_STR, failedDoc, CR_STR, Chr(13)) 2753 End If 2754 2755 WriteDebug str 2756 MsgBox str, vbCritical 2757 2758 Resume FinalExit 2759End Function 2760 2761Sub SetupInputVariables(logFile As String, fso As FileSystemObject) 2762 Dim bNewResultsFile As Boolean 2763 2764 bNewResultsFile = CheckCreateNewResultsFile(fso) 2765 2766 WriteToLog CNEW_RESULTS_FILE, IIf(bNewResultsFile, "True", "False"), mIniFilePath 2767 WriteToLog CNEW_RESULTS_FILE, IIf(bNewResultsFile, "True", "False"), logFile 2768End Sub 2769 2770 2771 2772Function RunExcelAnalysis(resultsTemplate As String, logFile As String, fsObject As FileSystemObject) As Boolean 2773 On Error GoTo HandleErrors 2774 Dim currentFunctionName As String 2775 currentFunctionName = "RunExcelAnalysis" 2776 Const APP_EXCEL = "Excel" 2777 Dim str As String 2778 Dim bSuccess 2779 bSuccess = False 2780 2781 If (chkExcelDoc.value <> vbChecked) And (chkExcelTemplate.value <> vbChecked) Then 2782 RunExcelAnalysis = True 2783 Exit Function 2784 End If 2785 2786 Dim xl As Excel.application 2787 Dim aWb As Excel.Workbook 2788 Dim sExcelDriverDocPath As String 2789 Dim RegValue As Long 2790 2791 sExcelDriverDocPath = fsObject.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CEXCEL_DRIVER_FILE) 2792 If Not fsObject.FileExists(sExcelDriverDocPath) Then 2793 str = ReplaceTopic2Tokens(GetResString(ERR_MISSING_EXCEL_DRIVER), _ 2794 TOPIC_STR, sExcelDriverDocPath, CR_STR, Chr(13)) 2795 WriteDebug str 2796 MsgBox str, vbCritical 2797 bSuccess = False 2798 GoTo FinalExit 2799 End If 2800 2801 Set xl = GetExcelInstance 2802 If val(xl.Version) < CSUPPORTED_VERSION Then 2803 str = ReplaceTopic2Tokens(GetResString(ERR_SUPPORTED_VERSION), _ 2804 TOPIC_STR, xl.Version, CR_STR, Chr(13)) 2805 WriteDebug str 2806 MsgBox str, vbCritical 2807 bSuccess = False 2808 GoTo FinalExit 2809 End If 2810 2811 If Not CheckForAccesToExcelVBProject(xl) Then 2812 RegValue = -1 2813 If Not GiveAccessToMacroProject(APP_EXCEL, xl.Version, RegValue) Then 2814 Dim Style, response 2815 str = ReplaceTopic2Tokens(GetResString(ERR_NO_ACCESS_TO_VBPROJECT), _ 2816 TOPIC_STR, CAPPNAME_EXCEL, CR_STR, Chr(13)) 2817 WriteDebug str 2818 Style = vbYesNo + vbQuestion + vbDefaultButton1 2819 2820 response = MsgBox(str, Style) 2821 If response <> vbYes Then 2822 bSuccess = False 2823 GoTo FinalExit 2824 End If 2825 End If 2826 End If 2827 2828 Set aWb = xl.Workbooks.Open(fileName:=sExcelDriverDocPath) 2829 'Setup Input Variables 2830 'SetupInputVariables resultsTemplate, logFile, fsObject, CAPPNAME_EXCEL 2831 2832 'Run Excel Analysis 2833 xl.Run ("AnalysisTool.AnalysisDriver.AnalyseDirectory") 2834 2835 bSuccess = True 2836FinalExit: 2837 If RegValue <> -1 Then 2838 SetDefaultRegValue APP_EXCEL, xl.Version, RegValue 2839 End If 2840 If RegValue = 0 Then 2841 DeleteRegValue APP_EXCEL, xl.Version 2842 End If 2843 2844 If Not aWb Is Nothing Then 2845 If xl.Workbooks.count = 1 Then 2846 xl.Visible = False 2847 End If 2848 aWb.Close (False) 2849 End If 2850 Set aWb = Nothing 2851 2852 If Not xl Is Nothing Then 2853 If xl.Workbooks.count = 0 Then 2854 xl.Quit 2855 End If 2856 End If 2857 2858 Set xl = Nothing 2859 2860 RunExcelAnalysis = bSuccess 2861 Exit Function 2862 2863HandleErrors: 2864 bSuccess = False 2865 Set aWb = Nothing 2866 Set xl = Nothing 2867 Dim failedDoc As String 2868 2869 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 2870 2871 failedDoc = GetDebug(CAPPNAME_EXCEL, CANALYZING) 2872 If failedDoc = "" Or failedDoc = CSTR_ANALYSIS_LOG_DONE Then 2873 str = ReplaceTopic2Tokens(GetResString(ERR_AUTOMATION_FAILURE), _ 2874 TOPIC_STR, CAPPNAME_EXCEL, CR_STR, Chr(13)) 2875 Else 2876 str = ReplaceTopic2Tokens(GetResString(ERR_EXCEL_DRIVER_CRASH), _ 2877 TOPIC_STR, failedDoc, CR_STR, Chr(13)) 2878 End If 2879 2880 WriteDebug str 2881 MsgBox str, vbCritical 2882 2883 On Error Resume Next 2884 Resume FinalExit 2885End Function 2886 2887Sub WriteWizardSettingsToLog(path As String) 2888 '### DO NOT USE Boolean True/ False it is loaclised by the OS - use "True"/ "False" 2889 WriteToLog CINPUT_DIR, getInputDir, path 2890 WriteToLog CINCLUDE_SUBDIRS, IIf(chkIncludeSubdirs.value, "True", "False"), path 2891 WriteToLog COUTPUT_DIR, getOutputDir, path 2892 WriteToLog CRESULTS_FILE, txtResultsName.Text, path 2893 2894 WriteToLog CTYPE_WORDDOC, IIf(chkWordDoc.value, "True", "False"), path 2895 WriteToLog CTYPE_WORDDOT, IIf(chkWordTemplate.value, "True", "False"), path 2896 WriteToLog CTYPE_EXCELDOC, IIf(chkExcelDoc.value, "True", "False"), path 2897 WriteToLog CTYPE_EXCELDOT, IIf(chkExcelTemplate.value, "True", "False"), path 2898 WriteToLog CTYPE_PPDOC, IIf(chkPPDoc.value, "True", "False"), path 2899 WriteToLog CTYPE_PPDOT, IIf(chkPPTemplate.value, "True", "False"), path 2900 2901 Dim resultsSetting As String 2902 If rdbResultsPrompt.value Then 2903 resultsSetting = CPROMPT_FILE 2904 ElseIf rdbResultsAppend.value Then 2905 resultsSetting = CAPPEND_FILE 2906 Else 2907 resultsSetting = COVERWRITE_FILE 2908 End If 2909 WriteToLog CRESULTS_EXIST, resultsSetting, path 2910 2911 WriteToLog CIGNORE_OLD_DOCS, IIf(chkIgnoreOld.value, "True", "False"), path 2912 WriteToLog CISSUE_LIMIT, CStr(mIssueLimit), path 2913 2914 'WriteToLog CVERSION, Version, path 2915End Sub 2916 2917Sub WriteCommonParamsToLog(resultsTemplate As String, logFile As String, path As String, fso As Scripting.FileSystemObject) 2918 WriteToLog CLOG_FILE, logFile, path 2919 WriteToLog CRESULTS_TEMPLATE, resultsTemplate, path 2920 WriteToLog CDEBUG_LEVEL, CLng(mDebugLevel), path 2921 WriteToLog CDOPREPARE, IIf(mbDoPrepare, "True", "False"), path 2922 WriteToLog CTITLE, frmWizard.Caption, path 2923 WriteToLog CLAST_CHECKPOINT, "" 2924 WriteToLog CNEXT_FILE, "" 2925 WriteToLog C_ABORT_ANALYSIS, "" 2926End Sub 2927 2928Function GetNumberOfDocsToAnalyze() As Long 2929 Dim count As Long 2930 2931 count = 0 2932 2933 If CheckWordDocsToAnalyze Then 2934 count = mWordDocCount + mWordTemplateCount 2935 End If 2936 If CheckExcelDocsToAnalyze Then 2937 count = count + mExcelDocCount + mExcelTemplateCount 2938 End If 2939 If CheckPPDocsToAnalyze Then 2940 count = count + mPPDocCount + mPPTemplateCount 2941 End If 2942 2943 GetNumberOfDocsToAnalyze = count 2944End Function 2945 2946Function CheckWordDocsToAnalyze() As Boolean 2947 2948 CheckWordDocsToAnalyze = mbDocCountCurrent And (chkWordDoc.value = vbChecked And mWordDocCount > 0) Or _ 2949 (chkWordTemplate.value = vbChecked And mWordTemplateCount > 0) 2950End Function 2951 2952Function CheckExcelDocsToAnalyze() As Boolean 2953 CheckExcelDocsToAnalyze = mbDocCountCurrent And (chkExcelDoc.value = vbChecked And mExcelDocCount > 0) Or _ 2954 (chkExcelTemplate.value = vbChecked And mExcelTemplateCount > 0) 2955End Function 2956 2957Function CheckPPDocsToAnalyze() As Boolean 2958 CheckPPDocsToAnalyze = mbDocCountCurrent And (chkPPDoc.value = vbChecked And mPPDocCount > 0) Or _ 2959 (chkPPTemplate.value = vbChecked And mPPTemplateCount > 0) 2960End Function 2961 2962Function CheckNumberDocsToAnalyze() As Boolean 2963 On Error GoTo HandleErrors 2964 Dim currentFunctionName As String 2965 currentFunctionName = "CheckNumberDocsToAnalyze" 2966 2967 Set mDocFiles = New CollectedFiles 2968 2969 Dim docSearchTypes As Collection 2970 Set docSearchTypes = New Collection 2971 2972 mbDocCountCurrent = False 2973 2974 SetupDocSearchTypes docSearchTypes 2975 2976 If (cbIgnoreOld.ListIndex = 0) Then 2977 mIssueLimit = 3 2978 ElseIf (cbIgnoreOld.ListIndex = 1) Then 2979 mIssueLimit = 6 2980 Else 2981 mIssueLimit = 12 2982 End If 2983 2984 If Not mDocFiles.Search(rootDir:=getInputDir, FileSpecs:=docSearchTypes, _ 2985 IncludeSubdirs:=IIf(chkIncludeSubdirs.value, mbTrue, mbFalse), _ 2986 ignoreOld:=IIf(chkIgnoreOld.value, mbTrue, mbFalse), Months:=mIssueLimit) Then 2987 CheckNumberDocsToAnalyze = False 2988 GoTo FinalExit 2989 End If 2990 2991 SetDocCountsFromFileSearch mDocFiles 2992 WriteFileDateCountsToLog mDocFiles 2993 2994 'WriteDocsToAnalyzeToLog mDocFiles 'UNCOMMENT Recovery - want to list out files to analyze 2995 2996 mbDocCountCurrent = True 2997 2998 lblNumDocs.Caption = ReplaceTopicTokens(GetResString(ANALYZE_DOCUMENTS_ID), TOPIC_STR, _ 2999 CStr(mWordDocCount)) 3000 lblNumTemplates.Caption = ReplaceTopicTokens(GetResString(ANALYZE_TEMPLATES_ID), TOPIC_STR, _ 3001 CStr(mWordTemplateCount)) 3002 3003 lblNumXLS.Caption = ReplaceTopicTokens(GetResString(ANALYZE_DOCUMENTS_XLS_ID), TOPIC_STR, _ 3004 CStr(mExcelDocCount)) 3005 lblNumXLT.Caption = ReplaceTopicTokens(GetResString(ANALYZE_TEMPLATES_ID), TOPIC_STR, _ 3006 CStr(mExcelTemplateCount)) 3007 3008 lblNumPPT.Caption = ReplaceTopicTokens(GetResString(ANALYZE_DOCUMENTS_PPT_ID), TOPIC_STR, _ 3009 CStr(mPPDocCount)) 3010 lblNumPOT.Caption = ReplaceTopicTokens(GetResString(ANALYZE_TEMPLATES_ID), TOPIC_STR, _ 3011 CStr(mPPTemplateCount)) 3012 3013 lblTotalNumDocs.Caption = ReplaceTopicTokens(GetResString(ANALYZE_TOTAL_NUM_DOCS_ID), TOPIC_STR, _ 3014 CStr(mTotalDocCount)) 3015 3016 If (mIgnoredDocCount > 0) Then 3017 lblSkippedOld.Caption = ReplaceTopicTokens(GetResString(RID_STR_ENG_ANALYZE_IGNORED_DOCS_ID), _ 3018 TOPIC_STR, CStr(mIgnoredDocCount)) 3019 lblSkippedOld.Visible = True 3020 Else 3021 lblSkippedOld.Visible = False 3022 End If 3023 3024 CheckNumberDocsToAnalyze = True 3025 3026FinalExit: 3027 Set docSearchTypes = Nothing 3028 Exit Function 3029 3030HandleErrors: 3031 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3032 Resume FinalExit 3033End Function 3034 3035Sub SetDocCountsFromFileSearch(myDocFiles As CollectedFiles) 3036 'No Error handling required 3037 mWordDocCount = myDocFiles.DocCount 3038 mWordTemplateCount = myDocFiles.DotCount 3039 mExcelDocCount = myDocFiles.XlsCount 3040 mExcelTemplateCount = myDocFiles.XltCount 3041 mPPDocCount = myDocFiles.PptCount 3042 mPPTemplateCount = myDocFiles.PotCount 3043 mTotalDocCount = mWordDocCount + mWordTemplateCount + mExcelDocCount + mExcelTemplateCount + _ 3044 mPPDocCount + mPPTemplateCount 3045 mIgnoredDocCount = myDocFiles.IgnoredDocCount 3046End Sub 3047 3048Sub SetupDocSearchTypes(docSearchTypes As Collection) 3049 'No Error handling required 3050 If chkWordDoc.value Then docSearchTypes.add ("*.doc") 3051 If chkWordTemplate.value Then docSearchTypes.add ("*.dot") 3052 If chkExcelDoc.value Then docSearchTypes.add ("*.xls") 3053 If chkExcelTemplate.value Then docSearchTypes.add ("*.xlt") 3054 If chkPPDoc.value Then docSearchTypes.add ("*.ppt") 3055 If chkPPTemplate.value Then docSearchTypes.add ("*.pot") 3056End Sub 3057 3058Sub WriteDocsToAnalyzeToLog(myDocFiles As CollectedFiles) 3059 On Error GoTo HandleErrors 3060 Dim currentFunctionName As String 3061 currentFunctionName = "WriteDocsToAnalyzeToLog" 3062 3063 Dim vFileName As Variant 3064 Dim Index As Long 3065 Dim limit As Long 3066 limit = myDocFiles.WordFiles.count 3067 For Index = 1 To limit 3068 vFileName = myDocFiles.WordFiles(Index) 3069 WriteToLog "Doc" & Index, CStr(vFileName), section:=(WIZARD_NAME & "ListFor" & CAPPNAME_WORD) 3070 Next 3071 limit = myDocFiles.ExcelFiles.count 3072 For Index = 1 To limit 3073 vFileName = myDocFiles.ExcelFiles(Index) 3074 WriteToLog "Doc" & Index, CStr(vFileName), section:=(WIZARD_NAME & "ListFor" & CAPPNAME_EXCEL) 3075 Next 3076 limit = myDocFiles.PowerPointFiles.count 3077 For Index = 1 To limit 3078 vFileName = myDocFiles.PowerPointFiles(Index) 3079 WriteToLog "Doc" & Index, CStr(vFileName), section:=(WIZARD_NAME & "ListFor" & CAPPNAME_POWERPOINT) 3080 Next 3081 3082FinalExit: 3083 Exit Sub 3084HandleErrors: 3085 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3086 Resume FinalExit 3087End Sub 3088 3089Sub WriteFileDateCountsToLog(myDocFiles As CollectedFiles) 3090 On Error GoTo HandleErrors 3091 Dim currentFunctionName As String 3092 currentFunctionName = "WriteFileDateCountsToLog" 3093 3094 WriteToLog C_DOCS_LESS_3_MONTH, CStr(myDocFiles.DocsLessThan3Months), mIniFilePath 3095 WriteToLog C_DOCS_LESS_6_MONTH, CStr(myDocFiles.DocsLessThan6Months), mIniFilePath 3096 WriteToLog C_DOCS_LESS_12_MONTH, CStr(myDocFiles.DocsLessThan12Months), mIniFilePath 3097 WriteToLog C_DOCS_MORE_12_MONTH, CStr(myDocFiles.DocsMoreThan12Months), mIniFilePath 3098 3099FinalExit: 3100 Exit Sub 3101HandleErrors: 3102 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3103 Resume FinalExit 3104End Sub 3105 3106 3107Function RunWordAnalysis(resultsTemplate As String, logFile As String, fsObject As FileSystemObject) As Boolean 3108 On Error GoTo HandleErrors 3109 Dim currentFunctionName As String 3110 currentFunctionName = "RunWordAnalysis" 3111 Const APP_WORD = "Word" 3112 Dim str As String 3113 Dim bSuccess 3114 bSuccess = False 3115 3116 Dim wrd As Word.application 3117 Dim aDoc As Word.Document 3118 Dim sWordDriverDocPath As String 3119 Dim RegValue As Long 3120 3121 If (chkWordDoc.value <> vbChecked) And (chkWordTemplate.value <> vbChecked) Then 3122 'No Word doc filters selected 3123 RunWordAnalysis = True 3124 Exit Function 3125 End If 3126 3127 sWordDriverDocPath = fsObject.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CWORD_DRIVER_FILE) 3128 If Not fsObject.FileExists(sWordDriverDocPath) Then 3129 str = ReplaceTopic2Tokens(GetResString(ERR_MISSING_WORD_DRIVER), _ 3130 TOPIC_STR, sWordDriverDocPath, CR_STR, Chr(13)) 3131 WriteDebug str 3132 MsgBox str, vbCritical 3133 bSuccess = False 3134 GoTo FinalExit 3135 End If 3136 3137 Set wrd = New Word.application 3138 If val(wrd.Version) < CSUPPORTED_VERSION Then 3139 str = ReplaceTopic2Tokens(GetResString(ERR_SUPPORTED_VERSION), _ 3140 TOPIC_STR, wrd.Version, CR_STR, Chr(13)) 3141 WriteDebug str 3142 MsgBox str, vbCritical 3143 bSuccess = False 3144 GoTo FinalExit 3145 End If 3146 3147 If Not CheckForAccesToWordVBProject(wrd) Then 3148 RegValue = -1 3149 If Not GiveAccessToMacroProject(APP_WORD, wrd.Version, RegValue) Then 3150 Dim Style, response 3151 str = ReplaceTopic2Tokens(GetResString(ERR_NO_ACCESS_TO_VBPROJECT), _ 3152 TOPIC_STR, CAPPNAME_WORD, CR_STR, Chr(13)) 3153 WriteDebug str 3154 Style = vbYesNo + vbQuestion + vbDefaultButton1 3155 3156 response = MsgBox(str, Style) 3157 If response <> vbYes Then 3158 bSuccess = False 3159 GoTo FinalExit 3160 End If 3161 End If 3162 End If 3163 3164 Set aDoc = wrd.Documents.Open(fileName:=sWordDriverDocPath) 3165 'Clear out any doc vars 3166 Dim MyObj As Variable 3167 For Each MyObj In aDoc.Variables 3168 MyObj.Delete 3169 Next 3170 3171 'Setup Input Variables 3172 'SetupInputVariables resultsTemplate, logFile, fsObject, CAPPNAME_WORD 3173 3174 wrd.Run ("AnalysisTool.AnalysisDriver.AnalyseDirectory") 3175 3176 wrd.Visible = False 3177 bSuccess = True 3178 3179FinalExit: 3180 If RegValue <> -1 Then 3181 SetDefaultRegValue APP_WORD, wrd.Version, RegValue 3182 End If 3183 If RegValue = 0 Then 3184 DeleteRegValue APP_WORD, wrd.Version 3185 End If 3186 If Not aDoc Is Nothing Then aDoc.Close (False) 3187 Set aDoc = Nothing 3188 3189 If Not wrd Is Nothing Then wrd.Quit (False) 3190 Set wrd = Nothing 3191 3192 RunWordAnalysis = bSuccess 3193 Exit Function 3194 3195HandleErrors: 3196 On Error Resume Next 3197 3198 bSuccess = False 3199 Set aDoc = Nothing 3200 Set wrd = Nothing 3201 3202 Dim failedDoc As String 3203 3204 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3205 3206 failedDoc = GetDebug(CAPPNAME_WORD, CANALYZING) 3207 If failedDoc = "" Or failedDoc = CSTR_ANALYSIS_LOG_DONE Then 3208 str = ReplaceTopic2Tokens(GetResString(ERR_AUTOMATION_FAILURE), _ 3209 TOPIC_STR, CAPPNAME_WORD, CR_STR, Chr(13)) 3210 Else 3211 str = ReplaceTopic2Tokens(GetResString(ERR_WORD_DRIVER_CRASH), _ 3212 TOPIC_STR, failedDoc, CR_STR, Chr(13)) 3213 End If 3214 3215 WriteDebug str 3216 MsgBox str, vbCritical 3217 3218 Resume FinalExit 3219End Function 3220 3221Function stripLastBackslash(inputStr As String) As String 3222 Const MIN_DIR_SIZE = 3 3223 On Error GoTo HandleErrors 3224 Dim currentFunctionName As String 3225 currentFunctionName = "stripLastBackslash" 3226 3227 If Len(inputStr) > MIN_DIR_SIZE Then 3228 Dim lastStrChar As String 3229 lastStrChar = Right(inputStr, 1) 3230 If lastStrChar = "\" Then 3231 inputStr = Left(inputStr, Len(inputStr) - 1) 3232 End If 3233 End If 3234 stripLastBackslash = inputStr 3235 3236 Exit Function 3237 3238HandleErrors: 3239 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3240 stripLastBackslash = inputStr 3241End Function 3242 3243Function getInputDir() As String 3244 getInputDir = stripLastBackslash(txtInputDir.Text) 3245End Function 3246 3247Function getOutputDir() As String 3248 Dim tmpStr As String 3249 3250 tmpStr = stripLastBackslash(txtOutputDir.Text) 3251 3252 'Bug when specifying C:\ 3253 If tmpStr <> "" Then 3254 If Right(tmpStr, 1) = "\" Then 3255 tmpStr = Left(tmpStr, Len(tmpStr) - 1) 3256 End If 3257 End If 3258 getOutputDir = tmpStr 3259End Function 3260 3261Function CheckCreateNewResultsFile(fsObject As FileSystemObject) As Boolean 3262 If Not fsObject.FileExists(getOutputDir & "\" & txtResultsName.Text) Then 3263 'No Results File - Create it 3264 CheckCreateNewResultsFile = True 3265 ElseIf rdbResultsAppend.value Then 3266 'Results File exists and user wants to append to it 3267 CheckCreateNewResultsFile = False 3268 Else 3269 'Results File exists and user has elected not to append 3270 CheckCreateNewResultsFile = True 3271 End If 3272End Function 3273 3274Sub DeleteFile(file As String) 3275 On Error GoTo HandleErrors 3276 Dim currentFunctionName As String 3277 currentFunctionName = "DeleteFile" 3278 Dim fso As Scripting.FileSystemObject 3279 Set fso = New Scripting.FileSystemObject 3280 Dim filePath As String 3281 3282 filePath = fso.GetAbsolutePathName(file) 3283 If fso.FileExists(filePath) Then 3284 fso.DeleteFile filePath, True 3285 End If 3286 3287FinalExit: 3288 Set fso = Nothing 3289 Exit Sub 3290 3291HandleErrors: 3292 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3293 Resume FinalExit 3294End Sub 3295 3296Public Property Get Version() As String 3297 Version = app.Major & "." & app.Minor & "." & app.Revision 3298End Property 3299 3300Function GetExcelInstance() As Excel.application 3301 Dim xl As Excel.application 3302 On Error Resume Next 3303 'Try and get an existing instance 3304 Set xl = GetObject(, "Excel.Application") 3305 If Err.Number = 429 Then 3306 Set xl = CreateObject("Excel.Application") 3307 ElseIf Err.Number <> 0 Then 3308 Set xl = Nothing 3309 MsgBox "Error: " & Err.Description 3310 Exit Function 3311 End If 3312 Set GetExcelInstance = xl 3313 Set xl = Nothing 3314End Function 3315 3316Function CheckForAnalysisResultsWorkbook(analysisResultsName As String) As Boolean 3317 On Error GoTo HandleErrors 3318 Dim currentFunctionName As String 3319 currentFunctionName = "CheckForAnalysisResultsWorkbook" 3320 3321 CheckForAnalysisResultsWorkbook = False 3322 3323 Dim xl As Excel.application 3324 Set xl = GetExcelInstance 3325 3326 Dim aWb As Excel.Workbook 3327 For Each aWb In xl.Workbooks 3328 3329 If aWb.Name = analysisResultsName Then 3330 CheckForAnalysisResultsWorkbook = True 3331 Exit For 3332 End If 3333 Next aWb 3334 3335FinalExit: 3336 If Not xl Is Nothing Then 3337 If xl.Workbooks.count = 0 Then 3338 xl.Quit 3339 End If 3340 End If 3341 3342 Set xl = Nothing 3343 3344 Exit Function 3345 3346HandleErrors: 3347 Set xl = Nothing 3348 3349 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3350 Resume FinalExit 3351End Function 3352 3353Function CheckForExcel() As Boolean 3354 On Error GoTo HandleErrors 3355 Dim currentFunctionName As String 3356 currentFunctionName = "CheckForExcel" 3357 3358 CheckForExcel = False 3359 3360 Dim xl As Excel.application 3361 Set xl = GetExcelInstance 3362 3363 3364 If xl.Workbooks.count > 0 Then 3365 CheckForExcel = True 3366 End If 3367 3368FinalExit: 3369 If Not xl Is Nothing Then 3370 If xl.Workbooks.count = 0 Then 3371 xl.Quit 3372 End If 3373 End If 3374 3375 Set xl = Nothing 3376 3377 Exit Function 3378 3379HandleErrors: 3380 Set xl = Nothing 3381 3382 WriteDebug currentFunctionName & " : " & Err.Number & " " & Err.Description & " " & Err.Source 3383 Resume FinalExit 3384End Function 3385 3386Public Function GetIniSetting(key As String) As String 3387 3388 If mIniFilePath = "" Or key = "" Then Exit Function 3389 3390 GetIniSetting = ProfileGetItem(WIZARD_NAME, key, "", mIniFilePath) 3391End Function 3392 3393Sub WriteIniSetting(key As String, value As String) 3394 3395 If mIniFilePath = "" Or key = "" Then Exit Sub 3396 3397 Call WritePrivateProfileString(WIZARD_NAME, key, value, mIniFilePath) 3398End Sub 3399 3400Private Sub lblSetupComplete_Click(Index As Integer) 3401 3402End Sub 3403 3404Private Function CheckNeededFiles(missingFile As String) As Boolean 3405 3406 Dim fso As New FileSystemObject 3407 Dim filePath As String 3408 3409 CheckNeededFiles = False 3410 filePath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CWORD_DRIVER_FILE) 3411 If Not fso.FileExists(filePath) Then 3412 missingFile = filePath 3413 Exit Function 3414 End If 3415 3416 filePath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CEXCEL_DRIVER_FILE) 3417 If Not fso.FileExists(filePath) Then 3418 missingFile = filePath 3419 Exit Function 3420 End If 3421 3422 filePath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CPP_DRIVER_FILE) 3423 If Not fso.FileExists(filePath) Then 3424 missingFile = filePath 3425 Exit Function 3426 End If 3427 3428 filePath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CLAUNCH_DRIVERS_EXE) 3429 If Not fso.FileExists(filePath) Then 3430 missingFile = filePath 3431 Exit Function 3432 End If 3433 3434 filePath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CMSO_KILL_EXE) 3435 If Not fso.FileExists(filePath) Then 3436 missingFile = filePath 3437 Exit Function 3438 End If 3439 3440 filePath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CRESULTS_TEMPLATE_FILE) 3441 If Not fso.FileExists(filePath) Then 3442 missingFile = filePath 3443 Exit Function 3444 End If 3445 3446 filePath = fso.GetAbsolutePathName(CBASE_RESOURCE_DIR & "\" & CRESOURCE_DLL) 3447 If Not fso.FileExists(filePath) Then 3448 missingFile = filePath 3449 Exit Function 3450 End If 3451 3452 CheckNeededFiles = True 3453End Function 3454