I have a supplier that sends me certifications for material that I purchase. We have come up with a new system where the certs will be sent to me via e-mail as attachments to a specific account. I would like to automate the process so that everyday
a program runs that looks for new e-mails and when it finds one, it opens it and saves the attachments to a file share.
I found a nice piece of code that should do what I am looking to do but it isn't working. It executes but where it should be going through the e-mails it isn't finding any. I put in a bunch of debug code and found that my program is getting a
"440 Login Timeout" reply from the server when it requests a list of the e-mails in the account.
I have attached the code below. Any assistance would be appreciated.
Thanks.
John
--------------------------
Module Main
Sub Main()
Dim o As New MailAttach
Try
Dim sServerName As String = "mail.company.com"
o.User = "certs"
o.Password = "password"
o.ExtractionDirectory = "\\server\public\Certs"
Console.WriteLine("Program starting.")
Console.WriteLine("Username: " + o.User)
Console.WriteLine("Server: " + sServerName)
Console.WriteLine("File Location: \\server\public\Certs")
Console.WriteLine("Processing mailbox.")
o.ProcessMail("https://" + sServerName + "/exchange/" + o.User + "/inbox")
Console.WriteLine("Programming complete.")
o = Nothing
Catch ex As Exception
Console.WriteLine("ERROR: " + ex.Message)
End Try
End Sub
End Module
Imports System.Xml
Imports System.Xml.Xsl
Imports MSXML2
Imports System.IO
Public Class MailAttach
Inherits Base
Private _User As String
Private _Password As String
Private _ExtractionDirectory As String
Protected Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
'
End If
MyBase.Dispose(disposing)
End Sub
Public WriteOnly Property User() As String
Set(ByVal value As String)
_User = value.ToString
End Set
End Property
Public WriteOnly Property Password() As String
Set(ByVal value As String)
_Password = value.ToString
End Set
End Property
Public Property ExtractionDirectory() As String
Get
Return _ExtractionDirectory.ToString
End Get
Set(ByVal value As String)
If Microsoft.VisualBasic.Right(value.ToString, 1) = "\" Then
_ExtractionDirectory = value.Substring(1, value.Length - 1)
Else
_ExtractionDirectory = value.ToString
End If
End Set
End Property
Public Sub ProcessMail(ByVal MailURL As String, Optional ByVal XmlNode As System.Xml.XmlNode = Nothing)
Dim _XmlHttp40 As New MSXML2.ServerXMLHTTP40
Dim _XmlDataDocument As New System.Xml.XmlDataDocument
Dim _XmlNodeList As XmlNodeList = Nothing
Dim _XmlNode As System.Xml.XmlNode = Nothing
Dim _ResponseText As String = ""
Dim iNode As Integer = 0
Try
Console.WriteLine("MailURL: " + MailURL)
' Open exchange and request list of emails from a directory.
_XmlHttp40.open("PROPFIND", MailURL.ToString, False, _User.ToString, _Password.ToString)
_XmlHttp40.setRequestHeader("Depth", "1")
_XmlHttp40.setRequestHeader("Content-type", "xml")
_XmlHttp40.send()
' Store the data and open it in an xml document object.
_ResponseText = _XmlHttp40.responseText
' This is where I see the error
Console.WriteLine("Response: " + _ResponseText)
_XmlDataDocument.LoadXml(_ResponseText)
' Get a list of email nodes.
_XmlNodeList = _XmlDataDocument.GetElementsByTagName("a:href")
' Loop through the nodes and process each email.
Console.WriteLine("# of e-mails in inbox: " + CStr(_XmlNodeList.Count))
For iNode = _XmlNodeList.Count - 1 To 0 Step -1
Console.WriteLine("Processing email #" + CStr(iNode))
_XmlNode = _XmlNodeList.Item(iNode)
ProcessEmail(_XmlNode)
Next
_XmlHttp40 = Nothing
_XmlDataDocument = Nothing
_XmlNodeList = Nothing
_XmlNode = Nothing
Catch ex As Exception
Console.WriteLine("ERROR: " + ex.Message)
End Try
End Sub
Private Sub ProcessEmail(ByVal _XmlNode As System.Xml.XmlNode)
Dim _XmlHttp40 As New MSXML2.ServerXMLHTTP40
Dim _XmlDataDocument As New System.Xml.XmlDataDocument
Dim _XmlNodeList As XmlNodeList = Nothing
Dim _XmlAttachmentNameList As XmlNodeList = Nothing
Dim _XmlAttachmentNode As System.Xml.XmlNode = Nothing
Dim _XmlAttachmentNameNode As System.Xml.XmlNode = Nothing
Dim _ResponseText As String = ""
Dim iNode As Integer = 0
_XmlHttp40.open("X-MS-ENUMATTS", _XmlNode.InnerText, False, _User.ToString, _Password.ToString)
_XmlHttp40.setRequestHeader("Depth", "1")
_XmlHttp40.setRequestHeader("Content-type", "xml")
_XmlHttp40.send()
' Store the data and open it in an xml document object.
_ResponseText = _XmlHttp40.responseText
_XmlDataDocument.LoadXml(_ResponseText)
' Get a list of attachment nodes.
_XmlNodeList = _XmlDataDocument.GetElementsByTagName("a:href")
_XmlAttachmentNameList = _XmlDataDocument.GetElementsByTagName("e:attachmentfilename")
' Loop through the nodes and process each email.
For iNode = _XmlNodeList.Count - 1 To 0 Step -1
Console.WriteLine("Processing attachment #" + CStr(iNode))
_XmlAttachmentNode = _XmlNodeList.Item(iNode)
_XmlAttachmentNameNode = _XmlAttachmentNameList.Item(iNode)
ExtractAttachment(_XmlAttachmentNode, _XmlAttachmentNameNode)
Next
_XmlHttp40 = Nothing
_XmlDataDocument = Nothing
_XmlNodeList = Nothing
_XmlNode = Nothing
End Sub
Private Sub ExtractAttachment(ByVal _XmlNode As System.Xml.XmlNode, ByVal FileNameNode As System.Xml.XmlNode)
Dim _XmlHttp40 As MSXML2.XMLHTTP40
Debug.Print(_XmlNode.InnerText)
_XmlHttp40 = New MSXML2.XMLHTTP40
_XmlHttp40.open("GET", _XmlNode.InnerText, False, _User.ToString, _Password.ToString)
_XmlHttp40.send()
Dim _ResponseBody() As Byte = _XmlHttp40.responseBody
My.Computer.FileSystem.WriteAllBytes(_ExtractionDirectory & "\" & FileNameNode.InnerText, _ResponseBody, False)
_XmlHttp40 = Nothing
End Sub
End Class
Public Class Base
Implements IDisposable
Private disposedValue As Boolean = False ' To detect redundant calls
' IDisposable
Protected Overridable Sub Dispose(ByVal disposing As Boolean)
If Not Me.disposedValue Then
If disposing Then
' TODO: free unmanaged resources when explicitly called
End If
' TODO: free shared unmanaged resources
End If
Me.disposedValue = True
End Sub
#Region " IDisposable Support "
' This code added by Visual Basic to correctly implement the disposable pattern.
Public Sub Dispose() Implements IDisposable.Dispose
' Do not change this code. Put cleanup code in Dispose(ByVal disposing As Boolean) above.
Dispose(True)
GC.SuppressFinalize(Me)
End Sub
#End Region
End Class
John
Saving E-mail Attachments
