|
I am try to take a tiff document was emailed as an attachment to my exchange
2003 server and save the file on the network shared progragmatically.
Basically every 5 minutes I scan certain email folders. If a message is
present I check the message for the attachment of a TIF. If a TIF is present
I want to store the attachment on my network share.
I have look for days online and have written multiple processes but have yet
to hit the winning match.
Any assistance you can provide would be greatly appreciated.
Here is a code snippet:
Private Sub loadlist()
Dim oXmlHttp As New MSXML2.ServerXMLHTTP40
Dim xmlDOMParams As New System.Xml.XmlDataDocument
Dim xmlDOMParamsAttachement As New MSXML2.DOMDocument40
Dim xmlNdLstDonation, xmlNdLstDonation1 As XmlNodeList
Dim Str As String
Dim pwd As String = sUsername
With oXmlHttp
Try
.open("PROPFIND", sConnUrl, False, sUsername, sPassword)
Catch ex As Exception
MsgBox("There were problems accessing the remote exchange
server!" & Chr(13) & ex.Message, MsgBoxStyle.Critical, "Error in Connecting!")
Return
End Try
.setRequestHeader("Depth", "1")
.setRequestHeader("Content-type", "xml")
.send()
Str = .responseText
'Load the read mails into XML document'''
Try
xmlDOMParams.LoadXml(Str)
' xmlDOMParams.Save("c:\test2.txt")
Catch ex As Exception
MsgBox("Error in Loading Email Data. Make sure connection
URL, UserID and Password are accurate.")
MsgBox(ex.Message)
Return
End Try
'Get the list of text descriptions of all the mails'''
xmlNdLstDonation =
xmlDOMParams.GetElementsByTagName("e:textdescripti on")
'Get the List of Subjects of all the mails'''
'xmlNdLstDonation1 =
xmlDOMParams.GetElementsByTagName("d:subject")
xmlNdLstDonation1 = xmlDOMParams.GetElementsByTagName("a:href")
Dim i As Integer
Dim LastItemAdded, CurrentItem As String
LastItemAdded = "$$%%"
ListBox1.Items.Clear()
'Starts at 2 not to get the inbox reference: Saftety precaution
For i = 2 To xmlNdLstDonation1.Count - 1
CurrentItem = xmlNdLstDonation1(i).InnerXml()
If Not LastItemAdded = CurrentItem Then
'make sure we are not looking at a folder
If
UCase(Microsoft.VisualBasic.Right(xmlNdLstDonation 1(i).InnerXml, 4)) = ".EML"
Then
If
GetAttachmentsListXML(xmlNdLstDonation1(i).InnerXm l) = True Then
ListBox1.Items.Add(xmlNdLstDonation1(i).InnerXml)
LastItemAdded = CurrentItem
End If
End If
End If
Next i
End With
End Sub
Private Function GetAttachmentsListXML(ByVal strUrl As String) As Boolean
Dim HttpWebRequest As MSXML2.XMLHTTP40
Dim xmlDOMParams As New System.Xml.XmlDataDocument
Dim xmlNdLstDonation1 As XmlNodeList
Dim GetAttachmentsListXML1 As String
Dim i As Integer
GetAttachmentsListXML = False
HttpWebRequest = New MSXML2.XMLHTTP40
Try
With HttpWebRequest
.open("X-MS-ENUMATTS", strUrl, False, sUsername, sPassword)
.setRequestHeader("Depth", "1")
.setRequestHeader("Content-type", "xml")
.send()
GetAttachmentsListXML1 = HttpWebRequest.responseText
xmlDOMParams.LoadXml(GetAttachmentsListXML1)
xmlNdLstDonation1 =
xmlDOMParams.GetElementsByTagName("a:href")
For i = 0 To xmlNdLstDonation1.Count - 1
If
Microsoft.VisualBasic.Right(xmlNdLstDonation1.Item (0).InnerText.ToString(),
4) = ".TIF" Then
ReadAnAttatchment(xmlNdLstDonation1.Item(0).InnerT ext.ToString())
GetAttachmentsListXML = True
End If
Next
End With
Catch ex As Exception
MsgBox(ex.Message)
End Try
HttpWebRequest = Nothing
xmlDOMParams = Nothing
Return GetAttachmentsListXML
End Function
Private Sub ReadAnAttatchment(ByVal strattacmentURL As String)
Dim HttpWebRequest As MSXML2.XMLHTTP40
HttpWebRequest = New MSXML2.XMLHTTP40
HttpWebRequest.open("GET", strattacmentURL, False, sUsername,
sPassword)
HttpWebRequest.send()
MsgBox(HttpWebRequest.responseText)
End Sub
--
Best regards,
Tom
| 
