bb.donnay-software.com

Code: Select all

FUNCTION SendMailToOutLook( cSubject, cText, acFile, acEmail )

LOCAL oOutlookApplication, oOutlookMailItem, i, lStatus, aWait, ;
      lReloadOutlook := .f., cOutlook

DEFAULT cSubject := '', ;
        cText := ''

IF Valtype(acFile) = 'C'
  acFile := { acFile }
ENDIF

IF Valtype(acEmail) = 'C'
  acEmail := { acEmail }
ELSEIF Empty(acEmail)
  acEmail := {}
ENDIF

aWait := Pl_Wait("Loading Outlook")
oOutlookApplication := CreateObject("Outlook.Application")
Pl_Wait(aWait)

IF Valtype(oOutlookApplication) # 'O'
  DCMSGBOX 'Cannot send mail to Outlook for one of the following reasons:', ;
           '', ;
           'Outlook is Running (not as an Administrator)', ;
           'Outlook is not installed on your computer', ;
           '', ;
           'Do you want the application to try and close Outlook and send an email?' ;
          FONT '10.Lucida Console' ;
          YESNO TO lStatus

  IF lStatus
    IF !KillTask('OUTLOOK.EXE')
      RETURN .f.
    ENDIF
    Sleep(200)
    lReloadOutlook := .t.
  ELSE
    RETURN .f.
  ENDIF
ENDIF

aWait := Pl_Wait("Loading Outlook")
oOutlookApplication := CreateObject("Outlook.Application")
Pl_Wait(aWait)

IF Valtype(oOutlookApplication) # 'O'
  DCMSGBOX 'Cannot send an email to Outlook. Sorry!'
  RETURN .f.
ENDIF

// Creating a new MailItem
oOutlookMailItem := oOutlookApplication:CreateItem(olMailItem)

 acFile := _getAttachments()

 // Setting the new MailItem subject and body
 IF Empty(cSubject) .AND. Len(acFile) > 0
   cSubject := "Documents From "+GetFlg('other18')
 ENDIF

 oOutlookMailItem:Subject := cSubject
 IF Empty(cText) .AND. Len(acFile) > 0
   cText := "Greetings,"+CR_LF+CR_LF+"Enclosed please find "+;
            Alltrim(Num_2Text(Len(acFile), .F. )) + " attached document" +;
            IIF( Len(acFile) <> 1, "s", "")+"."+CR_LF+CR_LF+;
            "Thank You"+CR_LF+CR_LF+UserFullName()
 ENDIF
 oOutlookMailItem:Body := cText

 // Setting the new MailItem recipients
 FOR i := 1 TO Len(acEmail)
   oOutlookMailItem:Recipients:Add(acEmail[i])
 NEXT

 // Adding the new MailItem a file attachment
 FOR i := 1 TO Len(acFile)
   IF !Empty(acFile[i])
     oOutlookMailItem:Attachments:Add(acFile[i])
   ENDIF
 NEXT

// Sending the new MailItem
oOutlookMailItem:Display()
// oOutlookMailItem:Send()

// Releasing Outlook
// oOutlookApplication:Quit()

oOutlookApplication:Destroy()

IF lReloadOutlook
  cOutlook := FindOutlook()
  IF !Empty(cOutlook)
    RunShell('',cOutlook)
  ENDIF
ENDIF

RETURN nil

* ------------

FUNCTION FindOutlook()

LOCAL aOutlook, i, cOutlook := ''

aOutlook := { ;
  'C:\Program Files (x86)\Microsoft Office\root\Office16\outlook.exe', ;
  'C:\Program Files (x86)\Microsoft Office\Office14\outlook.exe',;
  'C:\Program Files (x86)\Microsoft Office\Office12\outlook.exe',;
  'C:\Program Files (x86)\Microsoft Office\Office11\outlook.exe' }

FOR i := 1 TO Len(aOutlook)
  cOutlook := aOutlook[i]
  IF FExists(cOutlook)
    RETURN cOutlook
  ENDIF
NEXT

RETURN ''

* ------------

FUNCTION KillTask( cTaskToKill )

LOCAL aTasks, nFound

RunShell('/C TaskList.Exe /V /FO CSV > tasklist.csv')

aTasks := DC_Csv2Array('tasklist.csv')

IF Empty(aTasks)
  DCMSGBOX 'Could not create TASKLIST.CSV'
  RETURN .f.
ENDIF

IF !Empty(cTaskToKill)
  nFound := AScan(aTasks,{|a|Trim(Upper(a[1])) == Upper(cTaskToKill)})
  IF nFound > 0
    RETURN _KillTask(aTasks[nFound,2])
  ENDIF
ENDIF

RETURN .f.

* ---------

STATIC FUNCTION _KillTask( cPID )

RunShell('/PID ' + cPID,'C:\windows\system32\TaskKill.Exe',.t.,.f.)

RETURN .t.