//**************************************
    //     
    // Name: Global Error Handler in VB.Net
    // Description:I saw the earier example 
    //     of a global 
    error handler written in C#, but 
    needed it written in VB for my 
    company. I translated the earlier 
    work into my version in VB. It was 
    suggested by a couple of people 
    that I provide my VB version, so 
    here it is. I just hope you find 
    it useful.
    You can visit the C# version at: 
    http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=948&lngWId;=10
    It was submitted by Joel 
    Thoms on 2/5/2003. Thanks to all
    that asked me to post the VB version.
    Special thanks to Charles Richardson
    for helping me track down a bug.
    When you paste the code into the IDE,
    most of the formatting should return.
    // By: Troy Blake
    //
    // Inputs:'Sample Use
    Try
    'Regular Code Here
    Catch MyErr As Exception
    ' Catch Errors
    ' Send Email Only
    SendHtmlError(MyErr, "yourname@yourBusiness.com")
    ' Show Error Only
    Response.Write(GetHTMLError(MyErr))
    End Try
    //
    // Assumes:'Code Statement
    SendHtmlError(MyErr, "yourname@yourBusiness.com")
    'To Show error without email
    Response.Write(GetHTMLError(MyErr))
    //
    // Side Effects:I hard-coded some of the
    //     more basic 
    aspects of the email. For example, 
    I hard-coded the from address, email 
    subject, etc. because I knew in 
    advance what I wanted them to be. 
    You could pass these values as part 
    of the call to the sub.
    I just needed an easy way to email 
    the formatted error message to me 
    in the event of an error. This 
    works great in ASP.Net and VB.Net 
    applications.
    //
    //This code is copyrighted and has    // limited warranties.Please see http://
    //     www.Planet-Source-Code.com/vb/scripts/Sh
    //     owCode.asp?txtCodeId=1111&lngWId;=10    //for details.    //**************************************
    //     
    
    'Code Module
    Imports System
    Imports System.Data
    Imports System.Web
    Imports System.Web.Mail
    Imports System.Collections.Specialized
    Module ModError
    Public Sub SendHtmlError(ByVal Ex As Exception, ByVal EmailAddress As String)
    Dim Mail As New MailMessage()
    Mail.From = "ERROR_HANDLER"
    Mail.To = EmailAddress
    Mail.Subject = "Custom Intranet Error"
    Mail.Body = GetHTMLError(Ex)
    Mail.BodyFormat = MailFormat.Html
    SmtpMail.SmtpServer = "100.1.1.1"
    SmtpMail.Send(Mail)
    End Sub
    Public Function GetHTMLError(ByVal Ex As Exception) As String
    'Returns HTML an formatted error message.
    Dim Heading As String
    Dim MyHTML As String
    Dim Error_Info As New NameValueCollection()
    Heading = "<TABLE BORDER=""0"" WIDTH=""100%"" CELLPADDING=""1"" CELLSPACING=""0""><TR><TD bgcolor=""black"" COLSPAN=""2""><FONT face=""Arial"" color=""white""><B> <!--HEADER--></B></FONT></TD></TR></TABLE>"
    MyHTML = "<FONT face=""Arial"" size=""4"" color=""red"">Error - " & Ex.Message & "</FONT><BR><BR>"
    Error_Info.Add("Message", CleanHTML(Ex.Message))
    Error_Info.Add("Source", CleanHTML(Ex.Source))
    Error_Info.Add("TargetSite", CleanHTML(Ex.TargetSite.ToString()))
    Error_Info.Add("StackTrace", CleanHTML(Ex.StackTrace))
    MyHTML += Heading.Replace("<!--HEADER-->", "Error Information")
    MyHTML += CollectionToHtmlTable(Error_Info)
    '// QueryString Collection
    MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "QueryString Collection")
    MyHTML += CollectionToHtmlTable(HttpContext.Current.Request.QueryString)
    '// Form Collection
    MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "Form Collection")
    MyHTML += CollectionToHtmlTable(HttpContext.Current.Request.Form)
    '// Cookies Collection
    MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "Cookies Collection")
    MyHTML += CollectionToHtmlTable(HttpContext.Current.Request.Cookies)
    '// Session Variables
    MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "Session Variables")
    MyHTML += CollectionToHtmlTable(HttpContext.Current.Session)
    '// Server Variables
    MyHTML += "<BR><BR>" + Heading.Replace("<!--HEADER-->", "Server Variables")
    MyHTML += CollectionToHtmlTable(HttpContext.Current.Request.ServerVariables)
    Return MyHTML
    End Function
    Public Function CollectionToHtmlTable(ByVal Collection As NameValueCollection) As String
    Dim TD As String
    Dim MyHTML As String
    Dim i As Integer
    TD = "<TD><FONT face=""Arial"" size=""2""><!--VALUE--></FONT></TD>"
    MyHTML = "<TABLE width=""100%"">" & _
    " <TR bgcolor=""#C0C0C0"">" & _
    TD.Replace("<!--VALUE-->", " <B>Name</B>") & _
    " " & TD.Replace("<!--VALUE-->", " <B>Value</B>") & "</TR>"
    'No Body? -> N/A
    If (Collection.Count <= 0) Then
    Collection = New NameValueCollection()
    Collection.Add("N/A", "")
    Else
    'Table Body
    For i = 0 To Collection.Count - 1
    MyHTML += "<TR valign=""top"" bgcolor=""#EEEEEE"">" & _
    TD.Replace("<!--VALUE-->", Collection.Keys(i)) & " " & _
    TD.Replace("<!--VALUE-->", Collection(i)) & "</TR> "
    Next i
    End If
    'Table Footer
    Return MyHTML & "</TABLE>"
    End Function
    Private Function CollectionToHtmlTable(ByVal Collection As HttpCookieCollection) As String
    'Converts HttpCookieCollection to NameValueCollection
    Dim NVC = New NameValueCollection()
    Dim i As Integer
    Dim Value As String
    Try
    If Collection.Count > 0 Then
    For i = 0 To Collection.Count - 1
    NVC.Add(i, Collection(i).Value)
    Next i
    End If
    Value = CollectionToHtmlTable(NVC)
    Return Value
    Catch MyError As Exception
    MyError.ToString()
    End Try
    End Function
    Private Function CollectionToHtmlTable(ByVal Collection As System.Web.SessionState.HttpSessionState) As String
    'Converts HttpSessionState to NameValueCollection
    Dim NVC = New NameValueCollection()
    Dim i As Integer
    Dim Value As String
    If Collection.Count > 0 Then
    For i = 0 To Collection.Count - 1
    NVC.Add(i, Collection(i).ToString())
    Next i
    End If
    Value = CollectionToHtmlTable(NVC)
    Return Value
    End Function
    Private Function CleanHTML(ByVal HTML As String) As String
    If HTML.Length <> 0 Then
    HTML.Replace("<", "<").Replace("\r\n", "<BR>").Replace("&", "&").Replace(" ", " ")
    Else
    HTML = ""
    End If
    Return HTML
    End Function
    End Module