Sending Email from Visual Basic - email

I am working on a project and part of this project is to send emails to a list of email addresses located in SQL.
I am using the following code, which, when sent, just throws a "Sending Failed" error. Nothing else.
Can anyone please help me out with this one? I would really appreciate it.
'Connect to SQL Server database and query out only Address column to fill into DataTable
Dim con As SqlConnection = New SqlConnection("Data Source=.\SQLEXPRESS;Initial Catalog=FigClubs;Integrated Security=True;Pooling=False")
Dim cmd As SqlCommand = New SqlCommand("SELECT Email FROM Members", con)
con.Open()
Dim myDA As SqlDataAdapter = New SqlDataAdapter(cmd)
Dim myDataTable As DataTable = New DataTable
myDA.Fill(myDataTable)
con.Close()
con = Nothing
'New a MailMessage instance
Dim mailMessage As MailMessage = New MailMessage()
mailMessage.From = New MailAddress(TextBox4.Text.Trim())
' Determine the mailMessage.To property based on CheckBox checked status
If CheckBox1.Checked = True Then
For Each dr As DataRow In myDataTable.Rows
mailMessage.To.Add(New MailAddress(dr.Item(0).ToString))
Next
Else
mailMessage.To.Add(New MailAddress(TextBox3.Text.Trim()))
End If
mailMessage.Subject = TextBox1.Text.Trim()
mailMessage.Body = TextBox2.Text.Trim()
Dim smtpClient As SmtpClient = New SmtpClient("smtp.google.com")
smtpClient.Port = ("587")
smtpClient.Credentials = New System.Net.NetworkCredential("HIDDEN", "HIDDEN")
smtpClient.Send(mailMessage)
Try
smtpClient.Send(mailMessage)
Catch smtpExc As SmtpException
'Log errors
MsgBox(smtpExc.Message)
Catch ex As Exception
'Log errors
MsgBox(ex.Message)
End Try
I got that code from a google search.
Any help you can provide to get this working would be so appreciated.
Thanks in advance,
Dan
EDIT - Got it to work:
Got it to work using the following. Just in case anyone else needs it:
Try
Dim Smtp_Server As New SmtpClient
Dim e_mail As New MailMessage()
Smtp_Server.UseDefaultCredentials = False
Smtp_Server.Credentials = New Net.NetworkCredential("HIDDEN", "HIDDEN")
Smtp_Server.Port = 587
Smtp_Server.EnableSsl = True
Smtp_Server.Host = "smtp.gmail.com"
e_mail = New MailMessage()
e_mail.From = New MailAddress(TextBox4.Text)
e_mail.To.Add(TextBox3.Text)
e_mail.Subject = TextBox1.Text
e_mail.IsBodyHtml = False
e_mail.Body = TextBox2.Text
Smtp_Server.Send(e_mail)
MsgBox("Mail Sent")
Catch error_t As Exception
MsgBox(error_t.ToString)
End Try
Thanks guys. Hope all is well :)

Okay, here's a great solution for you...
Imports System.Net.Mail 'Namespace for sending the email
Public Class Form1 'Whatever class your doing this from...
'I tested with a button click event...
Private Sub btnSendEmail_Click(sender As Object, e As EventArgs) Handles btnSendEmail.Click
Dim dtEmails As New DataTable
Dim strEmails() As String = {"testing#yahoo.com", "testing#gmail.com"}
Dim strBuilder As New System.Text.StringBuilder 'Can be used to build a message
'This was only for my testing...
dtEmails.Columns.Add("EmailAddress")
For Each Str As String In strEmails
dtEmails.Rows.Add(Str)
Next
'Loop through our returned datatable and send the emails...'
If dtEmails.Rows.Count > 0 Then
strBuilder.AppendLine("Emails Confirmation")
strBuilder.AppendLine(" ")
For i As Integer = 0 To dtEmails.Rows.Count - 1 'Whatever your datatbale is called'
Try
Dim newMail As New Mail 'Use our new mail class to set our properties for the email'
newMail.MailMessageTo = dtEmails.Rows(i).Item("EmailAddress") 'What your email address column name is in the data table'
newMail.MailSubject = "Just a Test email!"
newMail.MailMessage = "Did you get this email, please let me know!"
If Mail.SendMail(newMail) Then
strBuilder.AppendLine("SENT - " & dtEmails.Rows(i).Item("EmailAddress").ToString.ToUpper)
Else
strBuilder.AppendLine("FAILED - " & dtEmails.Rows(i).Item("EmailAddress").ToString.ToUpper)
End If
Catch ex As Exception
Continue For
End Try
Next
End If
If strBuilder.Length > 0 Then
MessageBox.Show(strBuilder.ToString())
End If
End Sub
End Class
'You can put this class at the bottom of your class your using...This handles the emails...
Public Class Mail
Public Property MailMessageTo As String
Public Property MailMessage As String
Public Property MailSubject As String
'This will send your mail...
Public Shared Function SendMail(ByVal oMail As Mail) As Boolean
Dim Smtp_Server As New SmtpClient
Dim e_mail As New MailMessage()
Try
Smtp_Server.UseDefaultCredentials = False
Smtp_Server.Credentials = New Net.NetworkCredential("EMAIL", "PASSWORD")
Smtp_Server.Port = 587
Smtp_Server.EnableSsl = True
Smtp_Server.Host = "smtp.gmail.com"
e_mail = New MailMessage()
e_mail.From = New MailAddress("EMAIL") 'Whatever you want here'
e_mail.To.Add(oMail.MailMessageTo)
e_mail.Subject = oMail.MailSubject
e_mail.IsBodyHtml = False
e_mail.Body = oMail.MailMessage
Smtp_Server.Send(e_mail)
Return True
Catch error_t As Exception
Return False
Finally
Smtp_Server = Nothing
e_mail = Nothing
End Try
End Function
End Class
This works really well, you can edit as needed to. This is much more organized and easier to maintain for what you would need. Also another good note to remember your looping through a DataTable sending emails, you may want to put some of this on a BackgroundWorker as this can lock up the UI thread... Another thing to check when looping through your DataTable, you may want to check if the email your referencing isn't 'DBNull.value', I didn't check for that, other wise it will throw an exception.
Happy Coding!

Related

Getting Email Addresses for Recipients (Outlook)

I have a code that I was able to string together that logs my sent emails into an excel sheet so i can use that data for other analysis.
In it, I have it resolving the name into an email as outlook shortens it ("Jimenez, Ramon" = email#address.com) as outlook configured this and it works when i send an email to anyone in my company as they are in my address book.
Now, when I email anyone outside it defaults to lastName, firstName so it is not converting this and logging it.
I thought the code I have in here already does this, but I guess not. I have already come this far and I am NOT a software guru at all. Does anyone have insight on how I can also include this as well?? Please see code below:
Private WithEvents Items As Outlook.Items
Const strFile As String = "C:\Users\a0227084\Videos\work\test.xlsx"
Private Sub Application_Startup()
Dim OLApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set OLApp = Outlook.Application
Set objNS = OLApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.GetDefaultFolder(olFolderSentMail).Items
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.MailItem
If TypeName(item) = "MailItem" Then
Set Msg = item
' ******************
FullName = Split(Msg.To, ";")
For i = 0 To UBound(FullName)
If i = 0 Then
STRNAME = ResolveDisplayNameToSMTP(FullName(i))
Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
ElseIf ResolveDisplayNameToSMTP(FullName(i)) <> "" Then
STRNAME = ResolveDisplayNameToSMTP(FullName(i))
Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
End If
Next i
'Call Write_to_excel(CStr(Msg.ReceivedTime), CStr(Msg.Subject), CStr(STRNAME))
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
Sub tes2t()
End Sub
Function getRecepientEmailAddress(eml As Variant)
Set out = CreateObject("System.Collections.Arraylist") ' a JavaScript-y array
For Each emlAddr In eml.Recipients
If Left(emlAddr.Address, 1) = "/" Then
' it's an Exchange email address... resolve it to an SMTP email address
out.Add ResolveDisplayNameToSMTP(emlAddr)
Else
out.Add emlAddr.Address
End If
Next
getRecepientEmailAddres = Join(out.ToArray(), ";")
End Function
Function ResolveDisplayNameToSMTP(sFromName) As String
' takes a Display Name (i.e. "James Smith") and turns it into an email address (james.smith#myco.com)
' necessary because the Outlook address is a long, convoluted string when the email is going to someone in the organization.
' source: https://stackoverflow.com/questions/31161726/creating-a-check-names-button-in-excel
Dim OLApp As Object 'Outlook.Application
Dim oRecip As Object 'Outlook.Recipient
Dim oEU As Object 'Outlook.ExchangeUser
Dim oEDL As Object 'Outlook.ExchangeDistributionList
Set OLApp = CreateObject("Outlook.Application")
Set oRecip = OLApp.Session.CreateRecipient(sFromName)
oRecip.Resolve
If oRecip.Resolved Then
Select Case oRecip.AddressEntry.AddressEntryUserType
Case 0, 5 'olExchangeUserAddressEntry & olExchangeRemoteUserAddressEntry
Set oEU = oRecip.AddressEntry.GetExchangeUser
If Not (oEU Is Nothing) Then
ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
End If
Case 10, 30 'olOutlookContactAddressEntry & 'olSmtpAddressEntry
Dim PR_SMTP_ADDRESS As String
PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
ResolveDisplayNameToSMTP = oRecip.AddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
End Select
End If
End Function
Sub Write_to_excel(str1 As String, str2 As String, str3 As String)
Dim xlApp As Object
Dim sourceWB As Workbook
Dim sourceWH As Worksheet
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.EnableEvents = False
End With
Set sourceWB = Workbooks.Open(strFile, False, False)
Set sourceWH = sourceWB.Worksheets("Sheet1")
sourceWB.Activate
With sourceWH
lastrow = .Cells(.rows.Count, "A").End(xlUp).Row
End With
sourceWH.Cells(lastrow + 1, 1) = str1
sourceWH.Cells(lastrow + 1, 2) = str2
sourceWH.Cells(lastrow + 1, 3) = str3
sourceWB.Save
sourceWB.Close
End Sub
Error message and corrected code
Regards,
Ramon
First of all, there is no need to create a new Application instance in the ResolveDisplayNameToSMTP method:
Set OLApp = CreateObject("Outlook.Application")
Instead, you can use the Application property available in the Outlook VBA editor out of the box.
Second, you need to use the following code to get the SMTP address from the AddressEntry object:
Dim PR_SMTP_ADDRESS As String
Set PR_SMTP_ADDRESS = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
ResolveDisplayNameToSMTP = oRecip.AddressEntry.PropertyAccessor.GetProperty(PR_SMTP_ADDRESS)
Instead of the following line:
ResolveDisplayNameToSMTP = oRecip.AddressEntry.Address
Read more about that in the How to get the SMTP Address of the Sender of a Mail Item using Outlook Object Model? article.

Updated Yahoo Weather API - .NET

I'm trying to implement the newest yahoo weather API in a .NET application (the one we were using was discontinued in favor of this new one): https://developer.yahoo.com/weather/documentation.html#commercial
Their only examples are in PHP and Java. I've done my best to convert the Java example to .NET but I still am getting a "401 - Unauthorized" response. I've gone over my code several times and cannot find any problems so I'm hoping someone else will be able to see where I went wrong. Code is below.
Private Sub _WeatherLoader_DoWork(sender As Object, e As DoWorkEventArgs)
Try
Dim oauth As New OAuth.OAuthBase
Dim forecastRssResponse As query
Dim appId As String = My.Settings.YahooAppID
Dim consumerKey As String = My.Settings.YahooAPIConsumerKey
Dim yahooUri As String = String.Format("{0}?location=billings,mt&format=xml", YAHOO_WEATHER_API_BASE_ENDPOINT)
Dim oAuthTimestamp As Integer = oauth.GenerateTimeStamp()
Dim oAuthNonce As String = oauth.GenerateNonce()
Dim parameters As New List(Of String)
Try
parameters.Add(String.Format("oauth_consumer_key={0}", consumerKey))
parameters.Add(String.Format("oauth_nonce={0}", oAuthNonce))
parameters.Add("oauth_signature_method=HMAC-SHA1")
parameters.Add(String.Format("oauth_timestamp={0}", oAuthTimestamp.ToString()))
parameters.Add("oauth_version=1.0")
' Encode the location
parameters.Add(String.Format("location={0}", HttpUtility.UrlEncode("billings,mt", Encoding.UTF8)))
parameters.Add("format=xml")
' Sort parameters ascending
parameters = parameters.OrderBy(Function(item) item).ToList()
Dim i As Integer = 0
Dim builder As New StringBuilder()
Do While (i < parameters.Count())
builder.Append(String.Format("{0}{1}", If(i > 0, "&", String.Empty), parameters(i)))
i += 1
Loop
Dim signatureString As String = String.Format("GET&{0}&{1}", HttpUtility.UrlEncode(YAHOO_WEATHER_API_BASE_ENDPOINT, Encoding.UTF8), HttpUtility.UrlEncode(builder.ToString(), Encoding.UTF8))
Dim oAuthSignature As String = _CreateOauthSignature(signatureString)
Dim authorizationLine As String = String.Format("OAuth oauth_consumer_key={0}, oauth_nonce={1}, oauth_timestamp={2}, oauth_signature_method=HMAC-SHA1, oauth_signature={3}, oauth_version=1.0", consumerKey, oAuthNonce, oAuthTimestamp, oAuthSignature)
Dim forecastRequest As WebRequest = WebRequest.Create(yahooUri)
forecastRequest.Headers.Add("Authorization", authorizationLine)
forecastRequest.Headers.Add("Yahoo-App-Id", appId)
' Cast to HttpWebRequest to set ContentType through property
CType(forecastRequest, HttpWebRequest).ContentType = "text/xml"
Dim forecastResponse As WebResponse = forecastRequest.GetResponse()
If forecastResponse IsNot Nothing Then
Using responseStream As Stream = forecastResponse.GetResponseStream()
Dim rssDoc As New XmlDocument()
rssDoc.Load(responseStream)
forecastRssResponse = rssDoc.OuterXml().FromXml(Of query)()
End Using
e.Result = forecastRssResponse
End If
Catch ex As Exception
e.Result = Nothing
LoadingManually = False
End Try
Catch ex As Exception
modMain.SendDevErrorEmail(ex, "_WeatherLoader_DoWork in WeatherWidget", "Catch around dowork code in fired from refresh timer event in wether widget")
e.Result = Nothing
LoadingManually = False
End Try
End Sub
Private Function _CreateOauthSignature(baseInfo As String) As String
Dim secretKey As String = String.Format("{0}&", My.Settings.YahooAPIConsumerSecretKey)
Dim encoding As New System.Text.ASCIIEncoding()
Dim keyBytes As Byte() = encoding.GetBytes(secretKey)
Dim messageBytes As Byte() = encoding.GetBytes(baseInfo)
Dim hashMessage As Byte()
Using hmac As New HMACSHA1(keyBytes)
hashMessage = hmac.ComputeHash(messageBytes)
End Using
Return Convert.ToBase64String(hashMessage)
End Function
After painstakingly creating a Java app, pasting in the Java example and stepping through it I found that the issue is in a poorly implemented URL Decode function on the receiving end.
In the Java app, URL Encode uses upper case characters while in .NET HTTPUtility.URLEncode uses lower case characters. This is enough to throw off your signature and cause a 401 - Unauthorized error.
My solution was to create a string extension method that will URL Encode in upper case:
<Extension>
Public Function UppercaseURLEncode(ByVal sourceString As String) As String
Dim temp As Char() = HttpUtility.UrlEncode(sourceString).ToCharArray()
For i As Integer = 0 To temp.Length - 2
If temp(i).ToString().Equals("%", StringComparison.OrdinalIgnoreCase) Then
temp(i + 1) = Char.ToUpper(temp(i + 1))
temp(i + 2) = Char.ToUpper(temp(i + 2))
End If
Next
Return New String(temp)
End Function
Using this extension method my signature gets created exactly like the one in the Java app and I am able to retrieve the response.
Hope this helps other .net programmers with this issue!

Mail merge with Libre Office using .net

I have following code block which is working perfectly for OpenOffice SDK to automate Mail merge functionality.
Public Function runQueryOnDataSource(ByVal nameOfdDtaource As String, ByVal query As String) As Boolean
strLog = strLog + vbCrLf + Now.ToString() + ": runQueryOnDataSource nameOfdDtaource:" + nameOfdDtaource + ",query:" + query + "-Started"
Dim oDB As Object, oBase As Object
Dim oStatement As Object
Dim rSQL As String
Dim oRequete As Object
Dim oServiceManager As Object, CreateUnoService As Object
Try
'Creation instance Open office
oServiceManager = CreateObject("com.sun.star.ServiceManager")
CreateUnoService = oServiceManager.createInstance("com.sun.star.sdb.DatabaseContext")
mxMSFactory = (uno.util.Bootstrap.bootstrap()).getServiceManager()
oDB = CreateUnoService.getByName(nameOfdDtaource) 'oDB=XDataSource
'Connection
oBase = oDB.getConnection("", "") 'oBase=XConnection
oStatement = oBase.createStatement 'XStatement
'rSQL = "SELECT * FROM ""26_MailMergeResult_DEMO"
rSQL = query
oRequete = oStatement.execute(rSQL)
Return True
Catch ex As Exception
strLog = strLog + vbCrLf + Now.ToString() + ": Exception" + ex.ToString()
Throw ex
Finally
oDB = Nothing
oBase.Close()
oBase.Dispose()
End Try
strLog = strLog + vbCrLf + Now.ToString() + ": runQueryOnDataSource-Finished"
Return True
End Function
Above code is used to insert data into the DataSource already registered with libre office.But Now when I try to use it, line oServiceManager = CreateObject("com.sun.star.ServiceManager") generates error "Error Creating ActiveX object".
Do anyone have idea, How do I fix this.
This code does not look right, so I'm surprised it ever worked. In other examples, the bootstrap() line always goes first. Then use that service manager instead of a separate oServiceManager variable.
For example, see the Java code at https://www.openoffice.org/udk/common/man/spec/transparentofficecomponents.html.
EDIT:
You're almost there. The getByName() method returns uno.Any, which has a property called Value that DirectCast can use.
Dim oDB As XDataSource
Dim oBase As XConnection = Nothing
Dim xContext As XComponentContext = uno.util.Bootstrap.bootstrap()
Dim xMSFactory As XMultiServiceFactory = DirectCast(
xContext.getServiceManager(), XMultiServiceFactory)
Dim xNameAccess As XNameAccess = DirectCast(
xMSFactory.createInstance("com.sun.star.sdb.DatabaseContext"), XNameAccess)
oDB = DirectCast(xNameAccess.getByName("Bibliography").Value, XDataSource)
oBase = DirectCast(oDB.getConnection("", ""), XConnection)

Outlook addin exception

hi i wrote following code for save some mails (already imported to data grid using MAPI) to selected inbox folder in button click
Outlook.MAPIFolder oMailFolder = null;
Outlook.Application oApp = new Outlook.Application();
Outlook.NameSpace oNS = oApp.GetNamespace("MAPI");
MailItem moveFilteredMails = null;
oMailFolder = oNS.PickFolder();
oApp = null;
oNS = null;
List<UnreadEmails> filteredList = (List<UnreadEmails>)dgvUnreadMails.DataSource;
foreach (UnreadEmails item in filteredList)
{
moveFilteredMails.Move(oMailFolder);
}
but after selecting inbox folder from pickfilder method it gives a exception saying that
NullReferenceExceptionException was unhandled and Object reference not set to an instance of an object.
pls help to find the error
You wrote moveFilteredMails = null.
Since moveFilteredMails is null, you're getting a NullReferenceException when you try to move an item into it.

Crystal report create connection to OLE DB database

I am working with VS 2005 and using visual basic for coding.
How do I set up the connection object for my crystal report using vb code.
I have written some code
Dim strcon As String = ConfigurationManager.AppSettings("PhdConnectionString")
Dim getconn As SqlConnection = New SqlConnection(strcon)
Dim rpt As ReportDocument = New ReportDocument
rpt.Load(Server.MapPath("aspirantCrystalReport.rpt"))
// I want to set the connection properties here. How do I do that ?
CrystalReportViewer1.ReportSource = rpt
CrystalReportViewer1.DataBind()
I have not done this using the Crystal Reports .NET API, but I do have a working piece of code written in VB6 that calls the COM API. The API class and member names can't be that different.
Private Sub SetDataConnections(ByVal oReport As CRAXDRT.Report, ByVal oConnection As ADODB.Connection)
' Do all tables in this report.
Dim oTable As CRAXDRT.DatabaseTable
For Each oTable In oReport.Database.Tables
SetDataConnection oTable, oConnection
Next
' Find all subreports and do them too.
Dim oSection As CRAXDRT.Section
For Each oSection In oReport.Sections
Dim oObject As Object
For Each oObject In oSection.ReportObjects
If TypeOf oObject Is CRAXDRT.SubreportObject Then
Dim oSubreportObject As CRAXDRT.SubreportObject
Set oSubreportObject = oObject
SetDataConnections oSubreportObject.OpenSubreport()
Set oSubreportObject = Nothing
End If
Next
Next
End Sub
Private Sub SetDataConnection(ByVal oTable As CRAXDRT.DatabaseTable, ByVal oConnection As ADODB.Connection)
' Extract the relevant data from the ADO connection.
Dim sServer As String
Dim sDatabase As String
Dim bTrusted As String
Dim sUserName As String
Dim sPassword As String
Dim nTimeout As Long
With oConnection.Properties
sServer = .Item("Data Source").Value
sDatabase = .Item("Initial Catalog").Value
Select Case UCase(.Item("Integrated Security").Value)
Case "SSPI", "YES"
bTrusted = True
Case Else ' "NO", ""
bTrusted = False
End Select
sUserName = .Item("User ID").Value
sPassword = .Item("Password").Value
End With
nTimeout = oConnection.CommandTimeout
' Delete and re-create all connection information. This is the only way of getting it
' to work if the report contains subreports. Changing database drivers on the fly is
' not allowed, so we must re-create the connection using settings appropriate for the
' particular driver involved.
Select Case oTable.DllName
Case "crdb_ado.dll"
With oTable.ConnectionProperties
.DeleteAll
.Add "Database Type", "OLE DB (ADO)"
.Add "Provider", "SQLOLEDB"
.Add "Data Source", sServer
.Add "Initial Catalog", sDatabase
.Add "Integrated Security", bTrusted
.Add "User ID", sUserName
.Add "Password", sPassword
.Add "OLE DB Services", -1
.Add "General Timeout", nTimeout
End With
Case Else
' TODO: Handle other drivers appropriately.
End Select
End Sub