Email through access without extra software 1

[shmitty]

I see all these ways to send emails using existing email apps (esp. Outlook for obvious reasons) however, i would like to make it so when someone submits a trouble ticket at work it automatically sends me an email through the WAN's MS Exchange server without having the user log into their email software. I know this is possible in VB. Is it possible in VBA? If so, does anyone have any example code? I have searched extensively on the internet and cannot find anything helpful. Thanks for any information.

Jon

 

[rsinj]

If you are not going to use any extra software, and you want to do what you say, you are going to have to write what the extra software does yourself.

I used the MS Internet Control and wrote code to talk directly to a SMTP server on our LAN to send mail. Then, a year later, I found vbSendMail.DLL (freeware) and don't write any new email code without it.

You can easily use VBSendMail.DLL from VBA.

http://www.freevbcode.com/ShowCode.Asp?ID=109

 

[shmitty]

Sweet, thanks a bunch for the info.

Jon

 

[jwigal]

I've played around with this DLL a little bit and haven't been able to get any of the events to raise (e.g. success or errors). I can send e-mail, as long as the settings are set up properly.

I've read over the documentation. Here's what I'm doing:

I have the dll set as a reference

I am using the following code:

Module code:

Option Compare Database

 Sub cmdSend_Click()
'Assumes you have a form with text boxes named as below

Set poSendMail = New vbSendMail.clsSendMail

poSendMail.SMTPHost = "mail.mymailserver.com"
poSendMail.from = "jeff@wigaldesign.com"
poSendMail.FromDisplayName = "Jeff Wigal"
poSendMail.Recipient = "refasst@wigaldesign.com"
poSendMail.RecipientDisplayName = "Referee Assistant"
'poSendMail.ReplyToAddress = txtFrom.Text
poSendMail.Subject = "Test Message from VB #2 wd.com"
'poSendMail.Attachment = txtFileName.Text 'attached file name
poSendMail.Message = "Does this work" & vbCrLf & vbCrLf & "Hope so!"
If poSendMail.Connect Then

    poSendMail.Send
    poSendMail.Disconnect
    Debug.Print "Success!"

Else
    MsgBox "Not Successful"
End If

End Sub

Class module:

Option Compare Database
Option Explicit

Public WithEvents poSendMail As vbSendMail.clsSendMail
Public Event SendSuccesful()

Public Event SendFailed(Explanation As String)
Public Event Status(Status As String)
Public Event Progress(PercentComplete As Long)


Private Sub poSendMail_SendSuccesful()

    ' your code here .
    MsgBox "Mail Sent OK!"

End Sub

Private Sub poSendMail_SendFailed(Explanation As String)
    

    MsgBox "Mail Failed!" & vbCrLf & Explanation

End Sub

Any idea what I am doing wrong?

----------
Jeff Wigal
jeff@wigaldesign.com
Referee Assistant for MS Access

http://www.referee-assistant.com

 

[walejo89]

check this code I made this code to have the process you talking about. I am doing the same thing in my office and this is the code I did when I press the email send button on my access form.


Option Compare Database
Private lst As Access.ListBox
Dim Srt As DAO.Recordset
Dim rst As DAO.Recordset
Dim dbs As DAO.Database
Dim dbSS As DAO.Database

Private Sub cmdEMail_Click()


On Error GoTo ErrorHandler
Dim strEMailRecipient As String
Dim dteLastMeeting As Date
Dim strSubject As String

Dim strBody As String
Dim fld As Outlook.MAPIFolder
Dim msg As Outlook.MailItem
Dim gappOutlook As Outlook.Application

Dim appWord As Word.Application
Dim u As Integer
Dim i As String
Dim itm As Object
Dim lngAppointmentID As Long
Dim lngContactID As Long
Dim lngStatus As Long
Dim EmailRes As String

Dim nms As Outlook.NameSpace

Dim strFile As String


Dim varItem As Variant
Dim item1 As String
Dim item2 As String
Dim item3 As String
Dim item4 As String
Dim item5 As String
Dim item6 As String
Dim item7 As String
Dim item8 As Variant

Dim item9 As String
Dim item10 As String
Dim item11 As String
Dim item12 As String
Dim item13 As String
Dim item14 As String

Dim itemHL(20) As String

Dim n As Integer
Dim p As Long
Dim Email As String
Dim strMessage(1500) As String
Dim LC As Integer
'this function will email the set of record to the corecponding person.

'------------------------------------------------------------------------------------------------


Set lst = Me![qrySearchListBox]


p = lst.ItemsSelected.Count
LC = lst.ListCount

If LC = 1 Then
MsgBox "No records have been found in the listBox"
GoTo ErrorHandlerExit
End If

'Check that at least one record has been selected
If lst.ItemsSelected.Count = 0 Then
MsgBox "Please select at least one record"
lst.SetFocus
GoTo ErrorHandlerExit

End If
'strMessage (lst.ItemsSelected.Count)
'Set global Outlook application variable; if Outlook is not running,
'the error handler defaults to CreateObject

'Open text file for writing information about skipped records
'strFile = strDocsPath & "Skipped Records.txt"
'Open strFile For Output As #1
'Print #1, "These records were skipped when creating Outlook items"
'Print #1,
n = 0

For Each varItem In lst.ItemsSelected
'Get Contact ID for reference
item1 = Nz(lst.Column(0, varItem))
Debug.Print "Contact ID: " & item1

item2 = Nz(lst.Column(1, varItem))
Debug.Print "Contact ID: " & item2

item3 = Nz(lst.Column(2, varItem))
Debug.Print "Contact ID: " & item3

item4 = Nz(lst.Column(3, varItem))
Debug.Print "Contact ID: " & item4

item5 = Nz(lst.Column(4, varItem))
Debug.Print "Contact ID: " & item5

item6 = Nz(lst.Column(5, varItem))
Debug.Print "Contact ID: " & item6

item7 = Nz(lst.Column(6, varItem))
Debug.Print "Contact ID: " & item7

'item8 = Nz(lst.Column(7, varItem))
'Debug.Print "Contact ID: " & item8

item9 = Nz(lst.Column(8, varItem))
Debug.Print "Contact ID: " & item9

item10 = Nz(lst.Column(9, varItem))
Debug.Print "Contact ID: " & item10

item11 = Nz(lst.Column(10, varItem))
Debug.Print "Contact ID: " & item11

item12 = Nz(lst.Column(11, varItem))
Debug.Print "Contact ID: " & item12

item13 = Nz(lst.Column(12, varItem))
Debug.Print "Contact ID: " & item13

item14 = Nz(lst.Column(13, varItem))
Debug.Print "Contact ID: " & item14

'Check for required email information
varX = DLookup("[Attachment]", "SearchTable", "[SearID] =" & item12)

item8 = HyperlinkPart(varX, acAddress)
itemHL = item8
' Set itemHL = cas.Hyperlink
'With hlk

' .Address = item8
'End With



strMessage = Chr(12) & " IdNumber:" & item12 & Chr(12) & _
Chr(12) & item1 & " " & item2 & _
Chr(12) & "PS: " & " " & item3 & " | " & " SS: " & " " & item4 & _
Chr(12) & "CC: " & " " & item5 & " | " & " Phone: " & " " & item6 & " | " & " VPhone: " & item13 & " | " & " VCellPhone: " & item14 & _
Chr(12) & "Email: " & " " & item7 & " " & " | " & " Attachment" & n & _
Chr(12) & "Rate: " & " " & item9 & _
Chr(12) & "Communication: " & " " & item10 & " (out of 10)" & " " & " | " & " Manager:" & item11 & _
Chr(12) & "_______________________________________________________"
n = n + 1

Next varItem

Set lst = Nothing

'_____________________________________________________________________________________________________

Set lst = Me![EmailListBox]
'Check for required email information
For Each varItem In lst.ItemsSelected

Email = Nz(lst.Column(1, varItem))
EmailRes = EmailRes & Email & "; "

'strEMailRecipient = Nz(Me![cboRecipients].Column(1))




Next varItem


If lst.ItemsSelected.Count = 0 Then
MsgBox "Please select one recipient", vbOKOnly, "Email"
GoTo ErrorHandlerExit
Else
Debug.Print "EMail recipient: " & strEMailRecipient
End If

strSubject = "Records that have potential to be consultants"



'Create new mail message
u = 1
Set gappOutlook = GetObject(, "Outlook.Application.9")

'Set msg = gappOutlook.CreateItem(olMailItem)

u = 3
Set appWord = GetObject(, "Word.Application")

Set nms = gappOutlook.GetNamespace("MAPI")
Set fld = nms.GetDefaultFolder(olFolderOutbox)

'Set msg = gappOutlook.CreateItem(olMailItem)



Set msg = fld.Items.Add

With msg

.To = EmailRes
.Subject = strSubject

For m = 0 To p

strBody = strBody & " " & strMessage(m) & Chr(12) & Chr(12)


Next m
.HTMLBody = strBody
.Display


With Selection.Find
For l = 0 To p
If l = p Then
GoTo MessageSent
End If

.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
.Execute FindText:="Attachment" & l
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=itemHL(l), SubAddress:=""
Next l
End With
MessageSent:

.Body = ActiveDocument.Content
u = 0
closeapp:

ActiveDocument.Close
appWord.Quit
If u <> 2 Then
.Send
MsgBox "Your Email has been sent", vbOKOnly, "Email"
End If




End With
ErrorHandlerExit:
Exit Sub

ErrorHandler:
If Err = 462 Then
u = 2
MsgBox "You need to open OUTLOOK in order to send the email"
Resume Next
GoTo closeapp
ElseIf Err = 429 Then
'Outlook is not running; open Outlook with CreateObject
If u = 3 Then
Set appWord = CreateObject("Word.Application")
Resume Next
End If
If u = 1 Then
Set gappOutlook = CreateObject("Outlook.Application.9")
Resume Next
End If
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume ErrorHandlerExit
End If

End Sub



Private Sub Form_Open(Cancel As Integer)
Me.GenerateReport.Enabled = False

Me.qrySearchListBox.RowSource = ""
End Sub

Private Sub SS_GotFocus()
Dim SQLSecondary As String
Dim WordFin As String
Dim Pri As String
Dim Sec As String
Dim Te As String
Dim Cer As String

WordFin = Nz(Me![Word])
Pri = "PrimaryS"
Sec = "SecondaryS"

SQLPrimary = "INSERT INTO " & Sec & "([SecondarySkills]) values('" & WordFin & "')" & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL SQLPrimary
Me.Word = ""
End Sub

Private Sub PS_GotFocus()
Dim SQLPrimary As String
Dim WordFin As String
Dim Pri As String
Dim Sec As String
Dim Te As String
Dim Cer As String

WordFin = Nz(Me![Word])
Pri = "PrimaryS"
Sec = "SecondaryS"

SQLPrimary = "INSERT INTO " & Pri & "([PrimarySkills]) values('" & WordFin & "')" & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL SQLPrimary
Me.Word = ""
End Sub
Private Sub C_GotFocus()
Dim SQLPrimary As String
Dim WordFin As String
Dim Pri As String
Dim Sec As String
Dim Te As String
Dim Cer As String

WordFin = Nz(Me![Word])
Pri = "PrimaryS"
Sec = "SecondaryS"

SQLPrimary = "INSERT INTO " & Pri & "([PrimarySkills]) values('" & WordFin & "')" & ";"
DoCmd.SetWarnings False
DoCmd.RunSQL SQLPrimary
Me.Word = ""

End Sub

Private Sub EmailSearch_Click()
Dim EmailT As String
Dim StringSearch As String
Dim Result As Integer
Dim NumN As Integer
Dim NumS As Integer
Dim NumC As Integer
Dim NumT As Integer

Dim Num As Integer
Dim varX As Variant
Dim n As Integer
Dim Primary(50) As String
Dim ResultT As String
Dim QryResult As String
Dim PLikeP As String
Dim SLikeS As String
Dim SLikeWS As String
Dim CLikeC As String
Dim CLikeWC As String
Dim TLikeT As String
Dim TLikeWT As String

Dim PriSta As String
Dim Sqlme As String
Dim strRecordSorce As String
Dim strQuery As String
Dim PLikeWP As String
Dim Secondary(136) As String
Dim Cer(8) As String
Dim Tech(8) As String

Dim j As Integer
Dim r As Integer
Dim SCheck As String

strRecordSource = "qrySearch"
strQuery = "qryFilteredSearch"
QryResult = "qrysubSearchResults"

Set dbSS = CurrentDb
Set Srt = dbSS.OpenRecordset("SecondaryS", dbOpenTable)
NumS = Srt.RecordCount
EmailT = Nz(Me![EmailText])

If Len(EmailT) = 0 Then
MsgBox "No text found!", vbOKOnly, "No Text Found"
Me.GenerateReport.Enabled = False


Exit Sub
End If

If Len(EmailT) <> 0 Then
Me.GenerateReport.Enabled = True
End If

Dim myArray() As String

myArray = Split(EmailT)

'Set pr1 = Selection.Range.SpellingErrors
'sc = pr1.Count
'Set pr2 = Selection.Range.GrammaticalErrors
' gc = pr2.Count
'MsgBox "Spelling errors: " & sc & vbCr _
'& "Grammatical errors: " & gc



'here we going to bring the query in import whatever in this field and
'put in a array of strings.

'Provide how long you want the array to be.


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("PrimaryS", dbOpenTable)
NumN = rst.RecordCount

rst.MoveFirst
'rst.Fields
For i = 0 To NumN
'here we receive the value from each row of the primaryskills table and the field is'
'primary skill

ResultT = rst![PrimarySkills]
Primary(i) = ResultT

rst.MoveNext
If rst.EOF Then
GoTo Outside
End If
Next i

Outside:

rst.Close
Set rst = Nothing
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''






''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'today I accomplish the reading of the primary skills from the
'table and now I need to find this words in the email text and if i dont find'
'this words in the text dont put it in the ResuktArray to do the query.
'do this for the Secondary Skill and the technical skill.

NumN = NumN - 1
For i = 0 To NumN

'StringSearch =
'Result = InStr(1, EmailT, Primary(i), 1) 'search the whole document
'If Result <> 0 Then
'MsgBox "Word was found in the string", vbOKOnly, "Find Words"
For m = 0 To UBound(myArray)
If Primary(i) = myArray(m) Then
'here if the string is equals zero
myArray(m) = ""

If Len(PLikeP) <> 0 Then
If i = NumN Then
PLikeP = PLikeP & " or " & "[PrimarySkills] Like " & Chr$(34) & Chr$(42) & Primary(i) & Chr$(42) & Chr$(34)
PLikeWP = PLikeWP & " or " & "Like " & Chr$(34) & Chr$(42) & Primary(i) & Chr$(42) & Chr$(34)
End If
If i <> NumN Then
PLikeP = PLikeP & " or " & "[PrimarySkills] Like " & Chr$(34) & Chr$(42) & Primary(i) & Chr$(42) & Chr$(34)
PLikeWP = PLikeWP & " or " & "Like " & Chr$(34) & Chr$(42) & Primary(i) & Chr$(42) & Chr$(34)
End If

End If


If Len(PLikeP) = 0 Then
PLikeP = "[PrimarySkills] Like " & Chr$(34) & Chr$(42) & Primary(i) & Chr$(42) & Chr$(34)
PLikeWP = "Like " & Chr$(34) & Chr$(42) & Primary(i) & Chr$(42) & Chr$(34)

End If

If Len(PLikeP) = 0 And i = NumN Then
PLikeP = "[PrimarySkills] Like " & Chr$(34) & Chr$(42) & Primary(i) & Chr$(42) & Chr$(34)
LikeWP = "Like " & Chr$(34) & Chr$(42) & Primary(i) & Chr$(42) & Chr$(34)

End If

End If

'End If
'The word is not found
'If Result = 0 Then


Next m
Next i
''!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Here is where we do the calculation for the second skill
'make sure that the words in secondary skill field mactch the ones in the textbox



Srt.MoveFirst

For l = 0 To NumS

ResultT = Srt![SecondarySkills]
Secondary(l) = ResultT
'DLookup("[SecondarySkills]", "PrimaryS", "[IdNumber] =" & n)
'Here the information is in the primary Skills Array

Srt.MoveNext
If Srt.EOF Then
GoTo OutsideOut
End If
Next l

OutsideOut:

Srt.Close
Set Srt = Nothing
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''





'____________________________________________________________________________________________________________
'Here we going to do the sql statement for the SecondarySkill Field
'the query is going to be based on the secondary word keys that are found in the table of secondary skills


NumS = NumS - 1
For p = 0 To NumS

'Here I want to check if the words in the text are in the table for Secondary Skills
'myArray Contains all the word from trhe textbox

For k = 0 To UBound(myArray)
If Secondary(p) = myArray(k) And myArray(k) <> "" Then 'TextBox String

If Len(SLikeS) <> 0 Then
If p = NumS Then
SLikeS = SLikeS & " or " & "[SecondarySkills] Like " & Chr$(34) & Chr$(42) & Secondary(p) & Chr$(42) & Chr$(34)
SLikeWS = SLikeWS & " or " & "Like " & Chr$(34) & Chr$(42) & Secondary(p) & Chr$(42) & Chr$(34)
End If
If p <> NumS Then
SLikeS = SLikeS & " or " & "[SecondarySkills] Like " & Chr$(34) & Chr$(42) & Secondary(p) & Chr$(42) & Chr$(34)
SLikeWS = SLikeWS & " or " & "Like " & Chr$(34) & Chr$(42) & Secondary(p) & Chr$(42) & Chr$(34)
End If
End If

If Len(SLikeS) = 0 Then
SLikeS = "[SecondarySkills] Like " & Chr$(34) & Chr$(42) & Secondary(p) & Chr$(42) & Chr$(34)
SLikeWS = "Like " & Chr$(34) & Chr$(42) & Secondary(p) & Chr$(42) & Chr$(34)

End If


If Len(SLikeS) = 0 And p = NumS Then
SLikeS = "[SecondarySkills] Like " & Chr$(34) & Chr$(42) & Secondary(p) & Chr$(42) & Chr$(34)
SLikeWS = "Like " & Chr$(34) & Chr$(42) & Secondary(p) & Chr$(42) & Chr$(34)

End If
End If
Next k
Next p

'________________________________________________________________________~~_________________!!_!_!_!!!!!!!!!!!!!!!!!!!!!!!!!!
'______From here is the table of certified consultants
'here we do the operation and finds thre right people


Set rst = dbs.OpenRecordset("Cer", dbOpenTable)
NumC = rst.RecordCount

rst.MoveFirst
'rst.Fields
For i = 0 To NumC
'here we receive the value from each row of the CER table and the field is'
'cER

ResultT = rst![Certified]
Cer(i) = ResultT

rst.MoveNext
If rst.EOF Then
GoTo OutsideCer
End If
Next i

OutsideCer:

rst.Close
Set rst = Nothing


NumC = NumC - 1
For D = 0 To NumC

'Here I want to check if the words in the text are in the table for Secondary Skills
'myArray Contains all the word from trhe textbox
'Dim CLikeC As String
'Dim CLikeWC As String
For W = 0 To UBound(myArray)
If Cer(D) = myArray(W) And myArray(W) <> "" Then 'TextBox String

If Len(CLikeC) <> 0 Then
If D = NumC Then
CLikeC = CLikeC & " or " & "[Certified/NonCertified] Like " & Chr$(34) & Cer(D) & Chr$(42) & Chr$(34)
CLikeWC = CLikeWC & " or " & "Like " & Chr$(34) & Cer(D) & Chr$(42) & Chr$(34)
End If
If D <> NumC Then
CLikeC = CLikeC & " or " & "[Certified/NonCertified] Like " & Chr$(34) & Chr$(42) & Cer(D) & Chr$(42) & Chr$(34)
CLikeWC = CLikeWC & " or " & "Like " & Chr$(34) & Cer(D) & Chr$(42) & Chr$(34)
End If
End If

If Len(CLikeC) = 0 Then
CLikeC = "[Certified/NonCertified] Like " & Chr$(34) & Cer(D) & Chr$(42) & Chr$(34)
CLikeWC = "Like " & Chr$(34) & Chr$(42) & Cer(D) & Chr$(42) & Chr$(34)

End If


If Len(CLikeC) = 0 And D = NumC Then
CLikeC = "[Certified/NonCertified] Like " & Chr$(34) & Cer(D) & Chr$(42) & Chr$(34)
CLikeWC = "Like " & Chr$(34) & Cer(D) & Chr$(42) & Chr$(34)

End If
End If
Next W
Next D



'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


' _______________________________________________________________________________________________
'Here we going to do the Technical query and make sure that the text have tachnical word in it.

Set rst = dbs.OpenRecordset("Tech", dbOpenTable)
NumT = rst.RecordCount

rst.MoveFirst
'rst.Fields
For v = 0 To NumT
'here we receive the value from each row of the CER table and the field is'
'cER

ResultT = rst![Technical]
Tech(v) = ResultT

rst.MoveNext
If rst.EOF Then
GoTo OutsideTech
End If
Next v

OutsideTech:

rst.Close
Set rst = Nothing


NumT = NumT - 1
For e = 0 To NumT

'Here I want to check if the words in the text are in the table for Secondary Skills
'myArray Contains all the word from trhe textbox
'Dim CLikeC As String
'Dim CLikeWC As String
For f = 0 To UBound(myArray)
If Tech(e) = myArray(f) And myArray(f) <> "" Then 'TextBox String

If Len(TLikeT) <> 0 Then
If e = NumT Then
TLikeT = TLikeT & " or " & "[Certified/NonCertified] Like " & Chr$(34) & Tech(e) & Chr$(42) & Chr$(34)
TLikeWT = TLikeWT & " or " & "Like " & Chr$(34) & Tech(e) & Chr$(42) & Chr$(34)
End If
If e <> NumT Then
TLikeT = TLikeT & " or " & "[Technical/Functional] Like " & Chr$(34) & Chr$(42) & Tech(e) & Chr$(42) & Chr$(34)
TLikeWT = TLikeWT & " or " & "Like " & Chr$(34) & Tech(e) & Chr$(42) & Chr$(34)
End If
End If

If Len(TLikeT) = 0 Then
TLikeT = "[Technical/Functional] Like " & Chr$(34) & Tech(e) & Chr$(42) & Chr$(34)
TLikeWT = "Like " & Chr$(34) & Chr$(42) & Tech(e) & Chr$(42) & Chr$(34)

End If


If Len(TLikeT) = 0 And e = NumT Then
TLikeT = "[Technical/Functional] Like " & Chr$(34) & Tech(e) & Chr$(42) & Chr$(34)
TLikeWT = "Like " & Chr$(34) & Tech(e) & Chr$(42) & Chr$(34)

End If
End If
Next f
Next e



'__________________________________________________________________________________________________
'StringSearch =
'Result = InStr(1, EmailT, Secondary(p), 1) 'search the whole document
'If Result <> 0 Then
'MsgBox "Word was found in the string", vbOKOnly, "Find Words"

'here if the string is equals zero
'End If
'The word is not found
'if Result = 0 Then

'End If


'____________________________________________________________________________________________________________




'HERE is the wholen statement to execute in sql
'use this to execute that code.
Sqlme = "Select * From " & strRecordSource & " WHERE "


If PLikeWP <> "" And SLikeWS <> "" And CLikeWC <> "" And TLikeWT <> "" Then
Me![FilterString] = PLikeWP
Me![FilterStringS] = SLikeWS
Me![FilterStringC] = CLikeWC
Me![FilterStringT] = TLikeWT
PriSta = Sqlme & " (" & PLikeP & ")" & " and (" & SLikeS & ")" & " and (" & CLikeC & ")" & " and (" & TLikeT & ")"
GoTo OutofIf
End If

If PLikeWP = "" And SLikeWS = "" And CLikeWC = "" And TLikeWT = "" Then
Exit Sub
End If

If CLikeWC = "" And PLikeWP = "" And SLikeWS = "" Then
Me![FilterStringT] = TLikeWT
PriSta = Sqlme & TLikeT
GoTo OutofIf
End If

If CLikeWC = "" And PLikeWP = "" And TLikeWT = "" Then
Me![FilterStringS] = SLikeWS
PriSta = Sqlme & SLikeS
GoTo OutofIf
End If

If CLikeWC = "" And TLikeWT = "" And SLikeWS = "" Then
Me![FilterString] = PLikeWP
PriSta = Sqlme & PLikeP
GoTo OutofIf
End If

If PLikeWP = "" And TLikeWT = "" And SLikeWS = "" Then
Me![FilterStringC] = CLikeWC
PriSta = Sqlme & CLikeC
GoTo OutofIf
End If

If TLikeWT = "" And CLikeWC = "" Then
Me![FilterString] = PLikeWP
Me![FilterStringS] = SLikeWS
PriSta = Sqlme & " (" & PLikeP & ")" & " and (" & SLikeS & ")"
GoTo OutofIf
End If

If TLikeWT = "" And SLikeWS = "" Then
Me![FilterString] = PLikeWP
Me![FilterStringC] = CLikeWC
PriSta = Sqlme & " (" & PLikeP & ")" & " and (" & CLikeC & ")"
GoTo OutofIf
End If

If TLikeWT = "" And PLikeWP = "" Then
Me![FilterStringS] = SLikeWS
Me![FilterStringC] = CLikeWC
PriSta = Sqlme & " (" & SLikeS & ")" & " and (" & CLikeC & ")"
GoTo OutofIf
End If








If CLikeWC = "" And PLikeWP = "" Then
Me![FilterStringS] = SLikeWS
Me![FilterStringT] = TLikeWT
PriSta = Sqlme & " (" & SLikeS & ")" & " and (" & TLikeT & ")"
GoTo OutofIf
End If

If CLikeWC = "" And SLikeWS = "" Then
Me![FilterString] = PLikeWP
Me![FilterStringT] = TLikeWT
PriSta = Sqlme & " (" & PLikeP & ")" & " and (" & TLikeT & ")"
GoTo OutofIf
End If

If PLikeWP = "" And SLikeWS = "" Then
Me![FilterStringC] = CLikeWC
Me![FilterStringT] = TLikeWT
PriSta = Sqlme & " (" & CLikeC & ")" & " and (" & TLikeT & ")"
GoTo OutofIf
End If




If TLikeWT = "" Then
Me![FilterString] = PLikeWP
Me![FilterStringC] = CLikeWC
Me![FilterStringS] = SLikeWS
PriSta = Sqlme & " (" & PLikeP & ")" & " and (" & CLikeC & ")" & " and (" & SLikeS & ")"
GoTo OutofIf
End If

If CLikeWC = "" Then
Me![FilterString] = PLikeWP
Me![FilterStringS] = SLikeWS
Me![FilterStringT] = TLikeWT
PriSta = Sqlme & " (" & PLikeP & ")" & " and (" & SLikeS & ")" & " and (" & TLikeT & ")"
GoTo OutofIf
End If

If PLikeWP = "" Then
Me![FilterStringS] = SLikeWS
Me![FilterStringC] = CLikeWC
Me![FilterStringT] = TLikeWT
PriSta = Sqlme & " (" & SLikeS & ")" & " and (" & CLikeC & ")" & " and (" & TLikeT & ")"
GoTo OutofIf
End If

If SLikeWS = "" Then
Me![FilterString] = PLikeWP
Me![FilterStringC] = CLikeWC
Me![FilterStringT] = TLikeWT
PriSta = Sqlme & " (" & PLikeP & ")" & " and (" & CLikeC & ")" & " and (" & TLikeT & ")"
GoTo OutofIf
End If


OutofIf:

Debug.Print "SQL Statement: " & PriSta
Debug.Print CreateAndTestQuery(strQuery, PriSta) _
& " records found"

'DoCmd.OpenQuery strQuery, acViewNormal
Me.qrySearchListBox.RowSource = "SELECT [qryFilteredSearch].[Salutation], [qryFilteredSearch].[ConsultantName], [qryFilteredSearch].[PrimarySkills], [qryFilteredSearch].[SecondarySkills], [qryFilteredSearch].[CellPhoneNo],[qryFilteredSearch].[PhoneNo], [qryFilteredSearch]., [qryFilteredSearch].[Attachment], [qryFilteredSearch].[Rate/Salary], [qryFilteredSearch].[CommunicationSkills], [qryFilteredSearch].[Manager], [qryFilteredSearch].[SearID], [ConsultantInformation].[VenderContactNumber], [ConsultantInformation].[VenderCellContact] FROM qryFilteredSearch , ConsultantInformation WHERE [ConsultantInformation].[ConsultantName]=[qryFilteredSearch].[ConsultantName];"


End Sub

Private Sub Erase_Click()
Me.EmailText = ""
Me.qrySearchListBox.RowSource = ""
End Sub



Private Sub ReturnMail_Click()

Dim stAdminMain As String
Dim strResume As String
Dim strFilterLike As String
Dim strRecordSource As String
Dim strQuery As String
Dim strSQL As String

'++++++++++++++++++++++++++++++++++++++\

strFilterLike = "Like " & Chr$(34) & "DontFind" & Chr$(42) & Chr$(34)
strRecordSource = "qrySearch"
strQuery = "qryFilteredSearch"

strSQL = "SELECT * FROM " & strRecordSource & " WHERE [PrimarySkills] " _
& strFilterLike & ";"

Debug.Print "SQL Statement: " & strSQL
Debug.Print CreateAndTestQuery(strQuery, strSQL) _
& " records found"


'+++++++++++++++++++++++++++++++++++++++





stAdminMain = "Administrative Menu Form"

strResume = "SearchMail"


DoCmd.OpenForm stAdminMain, , , stLinkCriteria

DoCmd.Close acForm, strResume, acSavePrompt




End Sub

 

[walejo89]

'Create new mail message
u = 1
Set gappOutlook = GetObject(, "Outlook.Application.9")

'Set msg = gappOutlook.CreateItem(olMailItem)

u = 3
Set appWord = GetObject(, "Word.Application")

Set nms = gappOutlook.GetNamespace("MAPI")
Set fld = nms.GetDefaultFolder(olFolderOutbox)

'Set msg = gappOutlook.CreateItem(olMailItem)



Set msg = fld.Items.Add

With msg

.To = EmailRes
.Subject = strSubject

For m = 0 To p

strBody = strBody & " " & strMessage(m) & Chr(12) & Chr(12)


Next m
.HTMLBody = strBody
.Display


With Selection.Find
For l = 0 To p
If l = p Then
GoTo MessageSent
End If

.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
.Execute FindText:="Attachment" & l
ActiveDocument.Hyperlinks.Add Anchor:=Selection.Range, Address:=itemHL(l), SubAddress:=""
Next l
End With
MessageSent:

.Body = ActiveDocument.Content
u = 0
closeapp:

ActiveDocument.Close
appWord.Quit
If u <> 2 Then
.Send
MsgBox "Your Email has been sent", vbOKOnly, "Email"
End If




End With

 

[jwigal]

I will definitely take a look at this. Do you get the annoying "push the button" messages with this script?

I am just looking to avoid using Outlook and see if anyone has experience with event triggers with the vbSendMail DLL

----------
Jeff Wigal
jeff@wigaldesign.com
Referee Assistant for MS Access

http://www.referee-assistant.com

 

[VBslammer]

jwigal:

On your form, you need to declare your class module "WithEvents" using whatever name you gave your class. Once you do that, the events in your custom class will be available in the Procedure dropdown box.

Option Explicit

Private WithEvents mMailClass As clsMyCustomMailClass

Private Sub Form_Load()
  Set mMailClass = New clsMyCustomMailClass
End Sub

Private Sub cmdSend_Click()

  With mMailClass.MailObject
    .SMTPHost = "mail.mymailserver.com"
    .from = "jeff@wigaldesign.com"
    .FromDisplayName = "Jeff Wigal"
    .Recipient = "refasst@wigaldesign.com"
    .RecipientDisplayName = "Referee Assistant"
    '.ReplyToAddress = txtFrom.Text
    .Subject = "Test Message from VB #2 wd.com"
    '.Attachment = txtFileName.Text 'attached file name
    .Message = "Does this work" & vbCrLf & vbCrLf & "Hope so!"
    If .Connect Then
      .Send
      .Disconnect
      Debug.Print "Success!"
    Else
      MsgBox "Not Successful"
    End If
  End With
End Sub

Private Sub mMailClass_SendSuccessful()
  MsgBox "The SendSuccessful event fired."
End Sub

Private Sub mMailClass_SendFailed(Explanation As String)
  MsgBox "The SendFailed event fired: " & Explanation
End Sub

In your custom class, raise the events you created:

Private Withevents poSendMail As vbSendMail.clsSendMail

Public Event SendSuccesful()
Public Event SendFailed(Explanation As String)

Private Sub Class_Initialize()
  Set poSendMail = New vbSendMail.clsSendMail
End Sub

Public Property Get MailObject() As vbSendMail.clsSendMail
  Set MailObject = poSendMail
End Property

Private Sub poSendMail_SendSuccesful()
  RaiseEvent SendSuccessful()
End Sub

Private Sub poSendMail_SendFailed(Explanation As String)
  RaiseEvent SendFailed(Explanation)
End Sub

VBSlammer

"You just have to know which screws to turn." - Professor Bob

 

[jwigal]

What defines the name of the class? Is it the name of the class module (as seen from the database window), or is the name defined in the actual VB code (as seen in your example above)?

----------
Jeff Wigal
jeff@wigaldesign.com
Referee Assistant for MS Access

http://www.referee-assistant.com

 

[VBslammer]

The class name is whatever you named it in the code editor (properties window). To use the class, you have to reference it by its name.

VBSlammer

"You just have to know which screws to turn." - Professor Bob

 

[jwigal]

Perfect... thanks vbslammer!! i have another question related to references and distributing this DLL, but I'll ask it in another thread.

----------
Jeff Wigal
jeff@wigaldesign.com
Referee Assistant for MS Access

http://www.referee-assistant.com