Solved

VB Script to send e-mail

Posted on 2009-04-10
4
443 Views
Last Modified: 2012-06-27
I need a VB Script that will send e-mail, that is not dependent on CDO.  The script will run from desktops that have Outlook...I just do not want to depend on CDO.

Here is the current script:

I just want similar functionality without CDO.
strEmailDomainPos = instr(mailAdr, "@")

		GetEmailDomain = mid(mailAdr , strEmailDomainPos)

	End Function
 
 

	Sub GetSMTPServer 

		set cn = createobject("ADODB.Connection")

		set cmd = createobject("ADODB.Command")

		set rs = createobject("ADODB.Recordset")
 

		set objRoot = getobject("LDAP://RootDSE")

		configurationNC = objRoot.Get("configurationnamingcontext")
 

		cn.open "Provider=ADsDSOObject;"

		cmd.activeconnection = cn
 

		cmd.commandtext = "<LDAP://" & configurationNC & _

              ">;(objectCategory=msExchExchangeServer);name;subtree"

		set rs = cmd.execute
 

		while rs.eof<>true and rs.bof<>true

		      	strSMTPServer = rs(0)

			'msgbox rs(0)

		     	rs.movenext

		wend

	

		cn.close

	End sub
 

	Function GetEmail(strAccountName, strDomainName)
 

		Dim adoLDAPCon, adoLDAPRS, strLDAP
 

		Set adoLDAPCon = CreateObject("ADODB.Connection")

		adoLDAPCon.Provider = "ADsDSOObject"

		adoLDAPCon.Open "ADSI"

		strLDAP = "'LDAP://" & strDomainName & "'"

		Set adoLDAPRS = adoLDAPCon.Execute("select mail from " _

		 & strLDAP & " WHERE objectClass = 'user'"& _

		 " And samAccountName = '" & strAccountName & "'")

		With adoLDAPRS

			If Not .EOF Then

				GetEmail = .Fields("mail")

			Else

			        GetEmail = ""

			End If

		End With

		adoLDAPRS.Close

		Set adoLDAPRS = Nothing

		Set adoLDAPCon = Nothing

	End Function
 

	

	sub sendEmail
 

		Set objEmail = CreateObject("CDO.Message")

		objEmail.From = mailAdr

		objEmail.To = strEmailTo & strEmailDomain 

		msgbox objEmail.To

		objEmail.Subject = Summary.Value

		GetUserAddedInfo()

		objEmail.Textbody = Details.Value & vbCr & vbLf & strbaseInfo & vbCr & vbLf & GetUserAddedInfo 

		objEmail.Configuration.Fields.Item _

		 ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

		objEmail.Configuration.Fields.Item _

		 ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _

		     strSMTPServer

		objEmail.Configuration.Fields.Item _

		 ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

		objEmail.Configuration.Fields.Update

		objEmail.Send

                ExitProgram

	End Sub

Open in new window

0
Comment
Question by:bbanis2k
  • 3
4 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24118855
Hello bbanis2k,

        outlookMail strSubject:="Subject String", _
        strBody:="Body data is :", _
        strTo:="fred@fred.com", _
        SendYN:=False, _
        AttachYN:=attach <> "", _
        Attach1:=attach

Note:
    sendYN if true will send otherwise it will display the email
    attach is a comma seperated string of the filepaths for any attachmnets.

Any Help?

Regards,
Chris
Function outlookMail(strSubject As String, strBody As String, Optional strTo As String, _
                            Optional strCC As String, Optional strBCC As String, Optional SendYN As Boolean, _
                            Optional AttachYN As Boolean = False, Optional Attach1 As String) As Boolean
Dim olApp As Object
Dim olMsg As Object
Dim str() As String
Dim att As Variant 
    Set olApp = CreateObject("Outlook.Application")
    Set olMsg = olApp.CreateItem(0)
    With olMsg
        .To = strTo
        .CC = strCC
        .BCC = strBCC
        .subject = strSubject
        .body = strBody
        If AttachYN And Attach1 <> "" Then
            Attach1 = Replace(Attach1, ",", ";")
            str = Split(Attach1, ";")
            For Each att In str
                .Attachments.Add att
            Next
        End If
        If SendYN Then
            .Send
        Else
            .Display
        End If
    End With 
Set olMsg = Nothing
Set olApp = Nothing
End Function

Open in new window

0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 24120930
Apologies just realised you asked for script.

See as modified

Chris
attach = ""

outlookMail "Subject String", _

        "Body data is :", _

        "fred@fred.com", _

        "", _

        "", _

        False, _

        attach <> "", _

        attach

        

Sub outlookMail(strSubject, strBody, strTo, _

                            strCC, strBCC, SendYN, _

                            AttachYN, Attach1)

    Set olApp = CreateObject("Outlook.Application")

    Set olMsg = olApp.CreateItem(0)

    With olMsg

        .To = strTo

        .CC = strCC

        .BCC = strBCC

        .subject = strSubject

        .body = strBody

        If AttachYN And Attach1 <> "" Then

            Attach1 = Replace(Attach1, ",", ";")

            str = Split(Attach1, ";")

            For Each att In str

                .Attachments.Add att

            Next

        End If

        If SendYN Then

            .Send

        Else

            .Display

        End If

    End With 

Set olMsg = Nothing

Set olApp = Nothing

End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24903106
bbanis2k

What is the status of this Q from your perspective?

Chris
0
 

Author Closing Comment

by:bbanis2k
ID: 31569043
Thank you!
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
VBA additional condition 2 62
Vbscript 8 81
Modification on userform and column K 47 38
I want to make a copying program for vbs 1 39
Recently I finished a vbscript that I thought I'd share.  It uses a text file with a list of server names to loop through and get various status reports, then writes them all into an Excel file.  Originally it was put together for our Altiris server…
Deploying a Microsoft Access application in a Citrix environment is not difficult but takes a few steps. However, Citrix system people are often of little help, as they typically know next to nothing about Access. The script provided here will take …
Along with being a a promotional video for my three-day Annielytics Dashboard Seminor, this Micro Tutorial is an intro to Google Analytics API data.
In this video I am going to show you how to back up and restore Office 365 mailboxes using CodeTwo Backup for Office 365. Learn more about the tool used in this video here: http://www.codetwo.com/backup-for-office-365/ (http://www.codetwo.com/ba…

867 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now