<p>Sub cmdSendApprovedResponseClick ( Sender)
Dim strTo, strCC, strSubject, strBody, strContactEmail
Dim strDblCRLF
''' See included script: System:SLX Attachment Support where this is a Global Variable on that Script.
''' used on this form.
gStrAttachPath = Application.BasicFunctions.GetAttachmentPath
'Post any changes to the Ticket so we get the latest Ticket Data for the Email
Application.BasicFunctions.DoInvoke "Function", "File:Save" 'DNL
strTo = Trim(txtInboundEmail.Text) ''' Assume that we send the response to the same Email as the Inbound From Address.
If strTo = "" Then
strTo = Trim(lueContactEmail.Text) ''' if no inbound, then use Contact's EMAIL
If strTo = "" Then
''' Can't send an email to nobody!
MsgBox "The contact must have a valid EMail address."
Exit Sub
End If
End If
strCC = ""
strDblCRLF = vbCRLF & vbCRLF
strSubject = " RE: " & txtSubject.Text
strBody = strDblCRLF & memResponse.Text & strDblCRLF & "TicketID:" & gStrTicketId & " " ''''' & "TicketNo:" & ""
''' Attachment Support script.GetAttachmentEmailList goes after selected grid records.
''' June 3rd, User's want to select the Attachments specifically.
''' Select ALL records in the grid through code rather than the user selecting manually.
''' Call SelectAllRecordsInGrid ( grdAttach )
''' get the filenames from the selected rows in the attachments grid (grdAttach).
Dim strInvalidList, strAttachList, strTemp, strExt, strDescription, arrAttachment
Dim FSO, Shell, ShellEnv
Dim objRS
Dim i, x
strAttachList = Empty
strInvalidList = Empty
arrAttachment = Empty
Set FSO = CreateObject("Scripting.FileSystemObject") 'DNL
Set Shell = CreateObject("WScript.Shell") 'DNL
Set ShellEnv = Shell.Environment("PROCESS") 'DNL
strTemp = FSO.GetFolder(ShellEnv("TEMP")) & "\"
''' MsgBox " Get " & grdAttach.Selection.Count & " File Names and place into a List and an Array. "
For i = 0 To grdAttach.Selection.Count - 1
'Only add it to the list if the file actually exist
Set objRS = GetSelectedRecordByID(grdAttach.Recordset, grdAttach.Selection.Item(i), "ATTACHID") 'DNL
If Not (objRS.EOF) Then
''' MsgBox i & " " & objRS.Fields("FILENAME").Value
If DoesAttachmentExist(gStrAttachPath + objRS.Fields("FILENAME").Value, objRS.Fields("DESCRIPTION").Value, False) Then
strExt = FSO.GetExtensionName(objRS.Fields("FILENAME").Value) 'DNL
strDescription = objRS.Fields("DESCRIPTION").Value 'DNL
If strExt <> "" Then
strDescription = strDescription & "." & strExt
End If
strAttachList = strAttachList + strDescription + ";" 'DNL
' also return an array containing the FileName and Description of the available attachments
x = 0
If IsEmpty(arrAttachment) Then
ReDim arrAttachment(1, 0)
Else
x = uBound(arrAttachment, 2) + 1
ReDim Preserve arrAttachment(1, x)
End If
arrAttachment(0, x) = objRS.Fields("FILENAME").Value 'DNL
arrAttachment(1, x) = strDescription
''' MsgBox "x:= " & x & " " & arrAttachment(0, x) & " " & arrAttachment(1, x)
Else
strInvalidList = strInvalidList + objRS.Fields("DESCRIPTION").Value + vbCRLF 'DNL
End If
End If
Set objRS = Nothing
Next
If Not (IsEmpty(strAttachList)) Then
strAttachList = Left(strAttachList, Len(strAttachList) - 1)
End If
Set FSO = Nothing
Set Shell = Nothing
Set ShellEnv = Nothing
''' MsgBox " SendResponseEmail with attachments: " & strAttachList
''' send our Response via Outlook.
Call SendResponseEmail (strSubject, strTo, strCC, strBody, strAttachList, arrAttachment)
''' set the form now that the response has been 'sent' (the if statement allows you to quickly set up a Test button that calls this routine,
''' without resetting the form...
If Sender.Name = "cmdSendApprovedResponse" Then
dteResponseSent.DateTime = Now()
pklResponseStatus.Text = "Response Sent"
End If
Call FormLockdown
End Sub
<p>
Sub SendResponseEmail (ByVal strSubject, ByVal strContactList, ByVal strCCList, strHTMLBody, ByVal strAttachmentsList, ByRef arrAttachments)
Dim objOutlook
Dim objMailItem
Dim strSignature
Dim strToday
''' MsgBox " SendResponseEmail: strSubject " & strSubject & " Attachments: " & strAttachmentsList
''' Create Outlook mailitem.
Set objOutlook = CreateObject("Outlook.Application") 'DNL
if ErrorCheck (Application.Translator.Localize("Error creating Outlook Object:")) > 0 then
exit sub
end if
Set objMailItem = objOutlook.CreateItem(olMailItem)
if ErrorCheck (Application.Translator.Localize("Error creating MailItem Object:")) > 0 then
Set objOutlook = Nothing
exit sub
end if
' Display Blank Mail Item so we can get Signature
objMailItem.Display False
' Grab Signature
strSignature = objMailItem.HTMLBody
' Clear Body
objMailItem.Body = ""
objMailItem.HTMLBody = ""
objMailItem.HTMLBody = strHTMLBody
if strContactList <> "" then
''' strContactList = left (strContactList, len (strContactList) - 2)
objMailItem.Recipients.Add(strContactList)
objMailItem.Recipients.ResolveAll
end if
' add the subject
objMailItem.Subject = strSubject
' Add the signature after the body.
objMailItem.HTMLBody = objMailItem.HTMLBody & strSignature
If strAttachmentsList > "" Then
Dim FSO, Shell, ShellEnv, strTemp
Dim i
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Shell = CreateObject("WScript.Shell")
Set ShellEnv = Shell.Environment("PROCESS")
strTemp = FSO.GetFolder(ShellEnv("TEMP")) & "\"
For i = 0 To uBound(arrAttachments, 2)
''' MsgBox gStrAttachPath & arrAttachments(0,i) & " " & strTemp & arrAttachments(1,i)
If arrAttachments(1,i) > "" Then
FSO.CopyFile gStrAttachPath & arrAttachments(0,i), strTemp & arrAttachments(1,i)
objMailItem.Attachments.Add strTemp & arrAttachments(1,i)
End If
Next
End If
objMailItem.Display True
'Delete the temporary files we'we created
If strAttachmentsList > "" Then
For i = 0 To uBound(arrAttachments, 2)
If arrAttachments(1,i) > "" Then FSO.DeleteFile strTemp & arrAttachments(1,i)
Next
Set FSO = Nothing
Set Shell = Nothing
Set ShellEnv = Nothing
End If
' Clear Object
Set objOutlook = Nothing
Set objMailItem = Nothing
end sub