[VB.NET] แจกโค้ดฟรีในการส่งอีเมล์ พร้อมไฟล์แนบแบบหลายไฟล์ (Multiple Attachment)

thongkorn · โพสต์ 2018-11-12 13:55:21

เมื่อวานแอดมินแจกโค้ดฟรีในการส่งอีเมล์บน VB6 ด้วยการใช้งาน CDO (Collaboration Data Objects) วันนี้จัดโค้ด VB.NET โดยที่สามารถแนบไฟล์ (Attachment) ไปพร้อมๆกันได้หลายไฟล์ ทั้งกราฟิคและไฟล์เอกสาร ... อย่ารอช้าไปดูโค้ดกันเลย

โค้ดหลักในการส่งเมล์ ...

' / --------------------------------------------------------------------------
Public Sub SendMail()
'//
Try
Dim SmtpServer As New SmtpClient
Dim MyMail As New MailMessage()
With SmtpServer
.UseDefaultCredentials = False
.Credentials = New Net.NetworkCredential(txtUsername.Text, txtPassword.Text)
.Port = Val(txtPort.Text)
.EnableSsl = chkSSL.CheckState
.Host = txtServer.Text
End With
'//
MyMail = New MailMessage()
MyMail.From = New MailAddress(txtFromMail.Text, txtFromName.Text)
MyMail.To.Add(txtToMail.Text)
MyMail.Subject = txtSubject.Text
MyMail.IsBodyHtml = False
MyMail.Body = txtMessage.Text
'// Attach Files
If dgvData.RowCount > 0 Then
For i = 0 To dgvData.RowCount - 1
MyMail.Attachments.Add(New Net.Mail.Attachment(dgvData.Rows(i).Cells(0).Value))
Next
End If
'// SENDING
SmtpServer.Send(MyMail)
Catch ex As Exception
lblStatus.Text = ex.Message
Return
Finally
lblStatus.Text = "Send mail successfully."
'//
txtSubject.Clear()
txtMessage.Clear()
dgvData.Rows.Clear()
End Try
End Sub

คัดลอกไปที่คลิปบอร์ด

มาดูโค้ดแบบฉบับเต็มกันเถอะ ...

#Region "ABOUT"
' / --------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com (Khon Kaen - Thailand)
' / Facebook: https://www.facebook.com/g2gnet (For Thailand)
' / Facebook: https://www.facebook.com/commonindy (Worldwide)
' / Purpose: Send mail with VB.NET (2010)
' / Microsoft Visual Basic .NET (2010)
' /
' / This is open source code under @CopyLeft by Thongkorn/Common Tubtimkrob.
' / You can modify and/or distribute without to inform the developer.
' / --------------------------------------------------------------------------
#End Region
Imports System.Net.Mail
Imports System.IO
'// Link Reference.
'// https://docs.microsoft.com/en-us/dotnet/api/system.net.mail.smtpclient?redirectedfrom=MSDN&view=netframework-4.7.2
Public Class frmSendMailNet
'// Create MenuStrip @Run Time
Dim _contextmenu As New ContextMenuStrip
' / --------------------------------------------------------------------------
Private Sub frmSendMail_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'// SMTP Setting
Me.txtServer.Text = "smtp.gmail.com"
Me.txtUsername.Text = "yourmail@gmail.com" '<-- Change value
Me.txtPassword.Text = "yourpassword" '<-- Change value
Me.txtPort.Text = "587" '"465"
'// Body
Me.txtFromName.Text = "Your Name" '<-- Change value
Me.txtFromMail.Text = "yourname@gmail.com" '<-- Change value
Me.txtToMail.Text = "tosomeone@mail.com" '<-- Change value
Me.txtSubject.Text = "Test Mail " & Now()
Me.txtMessage.Text = "This is a test Email from Visual Basic .Net (2010) on " & Now
'// Setup DataGridView
Call InitializeGrid()
'// Add new contextmenu
_contextmenu.Items.Add("Image Files")
_contextmenu.Items.Add("Document Files")
AddHandler _contextmenu.ItemClicked, AddressOf Contextmenu_Click
End Sub
' / --------------------------------------------------------------------------
Private Sub Contextmenu_Click(ByVal sender As System.Object, ByVal e As ToolStripItemClickedEventArgs)
'// Choose item from contextmenu.
Select Case e.ClickedItem.Text
'// Browse Images
Case "Image Files"
_contextmenu.Visible = False
Call AttachFiles("image")
'// Browse Documents
Case "Document Files"
_contextmenu.Visible = False
Call AttachFiles("document")
End Select
End Sub
' / --------------------------------------------------------------------------
Private Sub btnAttach_Click(sender As System.Object, e As System.EventArgs) Handles btnAttach.Click
'// Show contextmenu on button @run Time.
_contextmenu.Show(btnAttach, 0, btnAttach.Height)
End Sub
' / --------------------------------------------------------------------------
Private Sub AttachFiles(ByVal FileType As String)
Dim dlgFile As OpenFileDialog = New OpenFileDialog()
Select Case FileType
Case "image"
' / Open File Dialog
With dlgFile
.InitialDirectory = Application.StartupPath
.Title = "Select images"
.Filter = "Image types (*.jpg;*.png;*.gif;*.bmp)|*.jpg;*.png;*.gif;*.bmp"
.FilterIndex = 1
.RestoreDirectory = True
End With
Case "document"
With dlgFile
.InitialDirectory = Application.StartupPath
.Title = "Select Document"
.Filter = "Document types (*.doc;*.docx;*.xls;*.xlsx;*.pdf)|*.doc;*.docx;*.xls;*.xlsx;*.pdf"
.FilterIndex = 1
.RestoreDirectory = True
End With
End Select
'/ Select OK after Browse ...
If dlgFile.ShowDialog() = DialogResult.OK Then
For i = 0 To dgvData.RowCount - 1
'// Not Duplicate
If dgvData.Rows(i).Cells(0).Value = dlgFile.FileName.ToString Then Return
Next
dgvData.Rows.Add()
dgvData.Rows(dgvData.RowCount - 1).Cells(0).Value = dlgFile.FileName.ToString
'// dgvData.Rows.Add(New String(){Value1, Value2, Value3})
End If
End Sub
' / --------------------------------------------------------------------------
Private Sub btnSend_Click(sender As System.Object, e As System.EventArgs) Handles btnSend.Click
'// Validate data before to sending them exclude attachments.
For Each gb As GroupBox In Me.Controls.OfType(Of GroupBox)()
For Each tb As TextBox In gb.Controls.OfType(Of TextBox)()
If Trim$(tb.Text) = vbNullString Then
lblStatus.Text = "Error: You must to enter all the field, exclude attachments."
MessageBox.Show(lblStatus.Text)
Exit Sub
End If
Next
Next
'//
Call SendMail()
'//
End Sub
' / --------------------------------------------------------------------------
Public Sub SendMail()
'//
Try
Dim SmtpServer As New SmtpClient
Dim MyMail As New MailMessage()
With SmtpServer
.UseDefaultCredentials = False
.Credentials = New Net.NetworkCredential(txtUsername.Text, txtPassword.Text)
.Port = Val(txtPort.Text)
.EnableSsl = chkSSL.CheckState
.Host = txtServer.Text
End With
'//
MyMail = New MailMessage()
MyMail.From = New MailAddress(txtFromMail.Text, txtFromName.Text)
MyMail.To.Add(txtToMail.Text)
MyMail.Subject = txtSubject.Text
MyMail.IsBodyHtml = False
MyMail.Body = txtMessage.Text
'// Attach Files
If dgvData.RowCount > 0 Then
For i = 0 To dgvData.RowCount - 1
MyMail.Attachments.Add(New Net.Mail.Attachment(dgvData.Rows(i).Cells(0).Value))
Next
End If
'// SENDING
SmtpServer.Send(MyMail)
Catch ex As Exception
lblStatus.Text = ex.Message
Return
Finally
lblStatus.Text = "Send mail successfully."
'//
txtSubject.Clear()
txtMessage.Clear()
dgvData.Rows.Clear()
End Try
End Sub
' / --------------------------------------------------------------------------
'// Setting is for DataGridView @Run Time.
Private Sub InitializeGrid()
'// Declare columns type.
Dim Column0 As New DataGridViewTextBoxColumn()
Dim Column1 As New DataGridViewButtonColumn
'// Add new Columns
dgvData.Columns.AddRange(New DataGridViewColumn() { _
Column0, Column1 _
})
'// Startup
With Column0
.Name = "FileAttach"
.HeaderText = "File Attachment"
.Visible = True
End With
With Column1
.HeaderText = ""
.Text = "Remove"
.Name = "btnDelRow"
.UseColumnTextForButtonValue = True
.Width = 60
.ReadOnly = True
End With
'//
With dgvData
.RowHeadersVisible = False
.AllowUserToAddRows = False
.AllowUserToDeleteRows = False
.AllowUserToResizeRows = False
.MultiSelect = False
.SelectionMode = DataGridViewSelectionMode.FullRowSelect
.ReadOnly = True
.Font = New Font("Tahoma", 9)
' Adjust the width each Column to fit.
.AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.Fill
'.AutoResizeColumns()
' Adjust Header Styles.
With .ColumnHeadersDefaultCellStyle
.BackColor = Color.Navy
.ForeColor = Color.White
.Font = New Font("Tahoma", 9, FontStyle.Bold)
End With
End With
End Sub
' / --------------------------------------------------------------------------
Private Sub dgvData_CellClick(sender As Object, e As System.Windows.Forms.DataGridViewCellEventArgs) Handles dgvData.CellClick
Select Case e.ColumnIndex
'// Remove row (Button)
Case 1
Call DeleteRow(dgvData.Columns(e.ColumnIndex).Name)
End Select
End Sub
' / --------------------------------------------------------------------------
' / Remove select row.
Private Sub DeleteRow(ByVal ColName As String)
If ColName = "btnDelRow" Then
'// Remove select row.
dgvData.Rows.Remove(dgvData.CurrentRow)
End If
End Sub
' / --------------------------------------------------------------------------
' / Get numeric only.
Function CheckDigitOnly(ByVal index As Integer) As Boolean
Select Case index
Case 48 To 57 ' 0 - 9
CheckDigitOnly = False
Case 8, 13 ' Backspace = 8, Enter = 13
CheckDigitOnly = False
Case Else
CheckDigitOnly = True
End Select
End Function
Private Sub btnExit_Click(sender As System.Object, e As System.EventArgs) Handles btnExit.Click
Me.Close()
End Sub
Private Sub frmSendMail_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Me.Dispose()
Application.Exit()
End Sub
Private Sub txtServer_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtServer.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
SendKeys.Send("{TAB}")
End If
End Sub
Private Sub txtSubject_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtSubject.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
SendKeys.Send("{TAB}")
End If
End Sub
Private Sub txtToMail_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtToMail.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
SendKeys.Send("{TAB}")
End If
End Sub
Private Sub txtUsername_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtUsername.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
SendKeys.Send("{TAB}")
End If
End Sub
Private Sub txtPort_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtPort.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
SendKeys.Send("{TAB}")
Else
e.Handled = CheckDigitOnly(Asc(e.KeyChar))
End If
End Sub
Private Sub txtPassword_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtPassword.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
SendKeys.Send("{TAB}")
End If
End Sub
Private Sub txtFromName_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtFromName.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
SendKeys.Send("{TAB}")
End If
End Sub
Private Sub txtFromMail_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtFromMail.KeyPress
If e.KeyChar = Chr(13) Then
e.Handled = True
SendKeys.Send("{TAB}")
End If
End Sub
Private Sub chkSSL_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles chkSSL.KeyDown
If e.KeyCode = 13 Then
e.Handled = True
SendKeys.Send("{TAB}")
End If
End Sub
End Class

คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ดฉบับเต็ม VB.NET (2010) ได้ที่นี่ ...

komenservice · โพสต์ 2020-10-21 21:08:22

ขอบพระคุณครับ อาจารย์
แต่ผมลองส่งเมลแล้ว Gmail มันบล๊อกครับ มันบอกไม่ได้เข้าสู่ระบบผ่านหน้าเว็บ

thongkorn · โพสต์ 2020-10-22 13:05:17

komenservice ตอบกลับเมื่อ 2020-10-21 21:08
ขอบพระคุณครับ อาจารย์
แต่ผมลองส่งเมลแล้ว Gmail มันบล๊อกครับ มันบอกไม่ได้เข้าสู่ระบบผ่านหน้าเว็บ

ต้องเปิดการเข้าถึงของแอพครับผม ...

komenservice · โพสต์ 2020-10-28 14:57:41

ขอบพระคุณครับ อาจารย์

outhai · โพสต์ 2022-6-6 09:52:04

แก้ไขครั้งสุดท้ายโดย outhai เมื่อ 2022-6-6 09:55

		จำสถานะนี้ไว้ในครั้งหน้า	ลืมรหัสผ่าน
รหัสผ่าน			ลงทะเบียน

[VB.NET] แจกโค้ดฟรีในการส่งอีเมล์ พร้อมไฟล์แนบแบบหลายไฟล์ (Multiple Attachment)

ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง

ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง

ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง