Question

作为一个新手，我只能在Microsoft visual studio中创建一个表单。但我的要求是发送外观邮件，而所有选项都应填写在VB.net中创建的表单中。例如，to地址将是VB.net形式的下拉列表。请帮助解决这个问题。

Answer 1

这是我写的一个小班，做同样的事情。我在网上查看了一些例子，发现了一些非常好的和坏的，并且做了这个小班。有些方法专门针对我们的需求而设置，但您应该能够根据自己的需要进行塑造。

 Public Class Email : Implements IDisposable
        Dim _e As String
        Dim _item As _MailItem
        ReadOnly _oApp = New Microsoft.Office.Interop.Outlook.Application

        Sub New()
            Try

                'Dim oApp As Microsoft.Office.Interop.Outlook._Application
                'If Me(Microsoft.Office.Interop.Outlook.Application)
                _item = _oApp.CreateItem(OlItemType.olMailItem)
            Catch ex As COMException
                MessageBox.Show("There was a problem with outlook on this machine.", "No Access to Email", MessageBoxButtons.OK, MessageBoxIcon.Warning)
                [Error] = True
            End Try
        End Sub

        Private Property [Error] As Boolean = False
        Private Property HasError As Boolean = False

        Public Sub AddAttachement(path As String)
            'Debug.Print(Path)
            _item.Attachments.Add(path)
        End Sub

        Public Shared Function GetAccountForEmailAddress(ByVal application As Microsoft.Office.Interop.Outlook.Application, ByVal address As String) As Account
            ' Loop over the Accounts collection of the current Outlook session.
            Dim account As Account
            For Each account In application.Session.Accounts
                ' When the e-mail address matches, return the account.
                Debug.Print(account.SmtpAddress.ToString)
                If account.SmtpAddress = address.ToString Then
                    Return account
                End If
            Next
            Dim message As String = $"No Account with Address: {address.ToString} exists!" & Environment.NewLine & Environment.NewLine & "Only:" & Environment.NewLine & String.Join(Environment.NewLine, GetAllEmailAccounts(application).ToArray) & Environment.NewLine & "exist on this computer."
            Throw New System.Exception(message.ToString)
        End Function

        Public Shared Function GetAllEmailAccounts(ByVal application As Microsoft.Office.Interop.Outlook.Application) As ArrayList
            ' Loop over the Accounts collection of the current Outlook session.
            Try
                Dim acc As New ArrayList()
                Dim account As Account
                For Each account In application.Session.Accounts
                    acc.Add(account.SmtpAddress.ToString)
                Next
                Return acc
            Catch ex As System.Exception
                MyError(ex)
                Return Nothing
            End Try
        End Function

       Public Sub Send()

            Try


                If HasError = False Then
                    _item.Send()
                    If ShowNotification = True Then
                        MessageBox.Show("Email successfully sent to: " & Environment.NewLine & _e.ToString, "Success", MessageBoxButtons.OK, MessageBoxIcon.Information)
                    End If

                End If
            Catch ex As System.Exception
                MyError(ex)
            Finally

            End Try
        End Sub

        Public Sub SentTo(emailAddress As String)
            For Each add In emailAddress.Split(";")
                'Debug.Print(RemoveWhitespace(add))
                _item.Recipients.Add(RemoveWhitespace(add))
            Next

            If Not _item.Recipients.ResolveAll Then
                HasError = True
                Throw New System.Exception("Could send email to the following addresses: " & Environment.NewLine & emailAddress.ToString)
            Else
                _e = emailAddress
            End If
        End Sub

        Public Function SetupEmail(subject As String, htmlBody As String, sendUsing As String) As Boolean

            'Dim defaultFolder As MAPIFolder = _oApp.Session.GetDefaultFolder(OlDefaultFolders.olFolderDrafts)
            Dim html = "<html><div style="" font-size:" & FontSize & "px;font-family:" & FontFamily & ";"">"
            html = html & htmlBody
            Try

                'item = DirectCast(Outlook.Application.CreateItem(OlItemType.olMailItem), Outlook.MailItem)

                Dim account As Account = GetAccountForEmailAddress(_oApp, sendUsing)
                'item = DirectCast(oApp.CreateItem(Outlook.OlItemType.olMailItem), Outlook.MailItem)
                'item.Recipients.Add(EmailAddress)
                _item.Subject = "--- Digital Certificate Attached ---"
                _item.SendUsingAccount = account

                _item.Subject = subject.ToString
                _item.SendUsingAccount = account

                _item.BodyFormat = OlBodyFormat.olFormatHTML
                _item.HTMLBody = String.Empty
                _item.HTMLBody = html
                _item.BodyFormat = OlBodyFormat.olFormatHTML

                Return True
            Catch exception1 As System.Exception

                HasError = True
                MyError(exception1)
                Return False
            End Try
        End Function

        Public Property FontFamily As String = "Tahoma"
        Public Property FontSize As Integer = 12

        Public ReadOnly Property HasErrrors As Boolean
            Get
                Return HasError
            End Get
        End Property

        Public Property ShowNotification As Boolean
            Get
                Return _ShowNotification
            End Get
            Set(value As Boolean)
                _ShowNotification = value
            End Set
        End Property
        Private Property _ShowNotification As Boolean = True

        Private _disposedValue As Boolean ' To detect redundant calls

        ' IDisposable
        Protected Overridable Sub Dispose(disposing As Boolean)
            If Not _disposedValue Then
                If disposing Then
                    ' TODO: dispose managed state (managed objects).
                    If _oApp IsNot Nothing Then
                        'Debug.Print("oWord has value")
                        Marshal.ReleaseComObject(_oApp)
                    End If

                    If _item IsNot Nothing Then
                        'Debug.Print("oWord has value")
                        Marshal.ReleaseComObject(_item)
                    End If

                End If


            End If
            _disposedValue = True
        End Sub

        Public Sub Dispose() Implements IDisposable.Dispose
            ' Do not change this code.  Put cleanup code in Dispose(disposing As Boolean) above.
            Dispose(True)

        End Sub
    End Class

我用以下方式使用它：

 Using myemail As New <ClassName>.Email
      myemail.SentTo(emailaddress)
      myemail.AddAttachement(attachment)
      If myemail.SetupEmail(EmailBody, Subject, SendingEmail) = True Then
      myemail.Send()
      End If
 End Using

需要在VB.net中从表单发送Outlook电子邮件

1 个答案: