I have a bot that is scanning my inbox periodically for specific emails. Whenever the code below is firing the cursor blinks and flashes when the cursor is over the Lotus Notes UI. Google returned about 5 results for my search and none of them seemed to address this issue. It's not preventing my program from working but it does look pretty bad aesthetically. Anyone out there have any ideas? Thanks!
*I also tagged this as C# to get more eyes looking at it. I'd prefer a vb.net solution but C# is welcome and appreciated as well.
Dim NS As Object = CreateObject("Notes.NotesSession")
Dim NDB As Object = NS.GetDatabase("", "")
If NDB.IsOpen = False Then NDB.Openmail()
Dim NV As Object = NDB.GetView("($Inbox)")
NV.refresh()
Dim ND As Object = NV.GetFirstDocument
Dim aItems As Array
Dim dInfo As Dictionary(Of String, String)
Dim EmailCount As Integer = NV.entrycount
Dim iCurrent As Integer = 0
Dim EmailDate As DateTime
Dim Subject As String, Body As String, sFrom As String
Do
iCurrent += 1
aItems = ND.Items
dInfo = New Dictionary(Of String, String)
For i As Integer = 0 To aItems.Length - 1
If Not dInfo.ContainsKey(aItems(i).name) Then
dInfo.Add(aItems(i).name, aItems(i).text)
End If
Next
EmailDate = CDate(dInfo("DeliveredDate"))
Subject = dInfo("Subject")
Body = dInfo("Body")
sFrom = dInfo("From")
If NV.GetNextDocument(ND) Is Nothing Then Exit Do
ND = NV.GetNextDocument(ND)
Loop
The Notes.NotesSession class is an OLE class, which means that it interacts with the Notes UI.
You should be using the COM version of the class instead, which is Lotus.NotesSession
Related
I'm basically writing a custom Error Logging Form for one of my applications because users cannot be trusted to report the errors to me.
I am obtaining the Form Name using the 'MethodBase' Object and then getting the DeclaringType Name.
Dim st As StackTrace = New StackTrace()
Dim sf As StackFrame = st.GetFrame(1)
Dim mb As MethodBase = sf.GetMethod()
Dim dt As String = mb.DeclaringType.Name
How can I then use this to obtain the Form Object so I can pass this to my 'screenshot method' that screenshots the particular form referenced.
Public Sub SaveAsImage(frm As Form)
'Dim fileName As String = "sth.png"
'define fileName
Dim format As ImageFormat = ImageFormat.Png
Dim image = New Bitmap(frm.Width, frm.Height)
Using g As Graphics = Graphics.FromImage(image)
g.CopyFromScreen(frm.Location, New Point(0, 0), frm.Size)
End Using
image.Save(_LogPath & Date.Now.ToString("ddMMyyyy") & ".png", format)
End Sub
I posted the same solution to a similar question. Try this:
Dim frm = Application.OpenForms.Item(dt)
I have a mechanism that downloads attachments from email messages sent into an inbox to a folder for processing by another service.
Originally this was done using some VBA that was triggered by a rule in Outlook. This wasn't build with large amounts of information going in originally however it has got to the point now that lots of data is being passed through and it is causing me headaches using this Outlook VBA and SSIS Package combination.
Therefore I am working on a new version built entirely in VB .NET, this obviously will mean its more robust and a lot easier to debug problems.
I have started using the EWS API and have managed to successfully connect to the Exchange and I am able to read the relevant messages and store their Subject etc. to variables.
I am struggling however to find ANY documentation / help regarding downloading of attachements with EWS with VB .NET code.
Everything seems to be in C# and I unfortunately have no experience with this. I am totally open to 3rd Party Solutions that may need to be purchased or even pointed in the right direction of a book or documentation, this is not being done on a shoe string and is quite important.
Try converters between C# and VB.
Regarding EWS, many VB examples contains "Exchange Web Services .NET". The same examples are in C# and VB
Hopefully this will get you started in the right direction. NOTE: I have not had a chance to test this VB code, since I do not have access to an Exchange 2007 server from home (as far as I know). However, I wrote this code carefully, basing it on C# code that I know works, because I used it at my workplace. See this link: http://www.sqlteam.com/forums/topic.asp?TOPIC_ID=105257. And this one: https://social.msdn.microsoft.com/Forums/sqlserver/en-US/dd2b465b-b1d2-4c0d-82ec-c36c6c482d5d/populating-sql-server-from-emails?forum=sqltools
FURTHER NOTE: This code will DELETE each email after saving the attachments from it. I think it will be a hard delete as well. In other words, you won't be able to pull the emails back out of the Deleted Items folder. You have been warned.
(It is possible to just mark each email as read instead of deleting it, but I don't have time to write the code for that just now. Hopefully this will be enough for your needs. If you still need this question answered.)
Namespace StephenGTuggy.Examples.SaveEWS2007Attachments
Public Module EWS2007ExampleMain
Enum AuthenticationMethod
Windows
Basic
End Enum
Private Const sUserName As String = "SampleUserName"
Private Const sPassword As String = "SamplePassword1"
Private Const sDomain As String = "mycompany.com"
Private Const eAuthenticationMethod As AuthenticationMethod = AuthenticationMethod.Basic
Private Const sEWS_URL As String = "https://mailserver.mycompany.com/EWS/Exchange.asmx"
'Private Const sEmailSender As String = "SampleUserName2#SomeOtherCompany.com"
Private Const sSaveAttachmentsToDirectory As String = "C:\"
Public Sub Main()
' Set up credentials to use to connect to the Exchange server.
Dim nc As System.Net.NetworkCredential = Nothing
Select Case eAuthenticationMethod
Case AuthenticationMethod.Windows
nc = System.Net.CredentialCache.DefaultNetworkCredentials
Case Else
nc = New System.Net.NetworkCredential(sUserName, sPassword, sDomain)
End Select
' Now bind to Exchange.
Dim esb As New ExchangeWebServices.ExchangeServiceBinding
esb.Url = sEWS_URL
esb.Credentials = nc
' Main code....
Dim findItemRequest As New ExchangeWebServices.FindItemType
findItemRequest.Traversal = ExchangeWebServices.ItemQueryTraversalType.Shallow
' Define which item properties Exchange should return for each email.
Dim itemProperties As New ExchangeWebServices.ItemResponseShapeType
itemProperties.BaseShape = ExchangeWebServices.DefaultShapeNamesType.AllProperties
findItemRequest.ItemShape = itemProperties
' Identify which folders to search to find items.
Dim folderIDInbox As New ExchangeWebServices.DistinguishedFolderIdType
folderIDInbox.Id = ExchangeWebServices.DistinguishedFolderIdNameType.inbox
Dim folderIDArray As ExchangeWebServices.DistinguishedFolderIdType() = {folderIDInbox}
findItemRequest.ParentFolderIds = folderIDArray
' Limit result set to unread emails only.
Dim restriction As New ExchangeWebServices.RestrictionType
Dim isEqualTo As New ExchangeWebServices.IsEqualToType
Dim pathToFieldType As New PathToUnindexedFieldType
pathToFieldType.FieldURI = ExchangeWebServices.UnindexedFieldURIType.messageIsRead '.messageFrom
Dim constantType As New ExchangeWebServices.FieldURIOrConstantType
Dim constantValueType As New ExchangeWebServices.ConstantValueType
constantValueType.Value = "0" 'sEmailSender
constantType.Item = constantValueType
isEqualTo.Item = pathToFieldType
isEqualTo.FieldURIOrConstant = constantType
restriction.Item = isEqualTo
findItemRequest.Restriction = restriction
' Send the request to Exchange and get the response back.
System.Diagnostics.Trace.TraceInformation("Sending FindItem request....")
Dim findItemResponse As ExchangeWebServices.FindItemResponseType = esb.FindItem(findItemRequest)
System.Diagnostics.Trace.TraceInformation("Received response to FindItem request.")
' Process response from Exchange server.
Dim folder As ExchangeWebServices.FindItemResponseMessageType = _
CType(findItemResponse.ResponseMessages.Items(0), ExchangeWebServices.FindItemResponseMessageType)
Dim folderContents As ExchangeWebServices.ArrayOfRealItemsType = _
CType(folder.RootFolder.Item, ExchangeWebServices.ArrayOfRealItemsType)
Dim items As ExchangeWebServices.ItemType() = folderContents.Items
For Each curItem As ExchangeWebServices.ItemType In items
Dim iAttCount As Integer = GetFileAttachmentsCount(esb, curItem.ItemId)
System.Diagnostics.Trace.TraceInformation("Subject: {0} DisplayTo: {1} DateTimeReceived: {2} ItemClass: {3} AttachmentCount: {4}", _
curItem.Subject.Trim(), _
curItem.DisplayTo.Trim(), _
curItem.DateTimeReceived.TimeOfDay.ToString(), _
curItem.ItemClass.Trim(), _
iAttCount)
If iAttCount > 0 Then
GetAttachmentsOnItem(esb, curItem.ItemId, sSaveAttachmentsToDirectory)
If Not MarkItemAsProcessed(esb, curItem.ItemId) Then
System.Diagnostics.Trace.TraceError("Unable to mark email as processed.")
End If
End If
Next
System.Diagnostics.Trace.TraceInformation("Finished processing emails and attachments.")
End Sub
Function GetFileAttachmentsCount(binding As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType) As Integer
Dim iAttachmentCount As Integer = 0
' Use GetItem on the Id to get the Attachments collection.
Dim getItemRequest As New ExchangeWebServices.GetItemType
getItemRequest.ItemIds = New ExchangeWebServices.ItemIdType() {id}
getItemRequest.ItemShape = New ExchangeWebServices.ItemResponseShapeType
getItemRequest.ItemShape.BaseShape = ExchangeWebServices.DefaultShapeNamesType.AllProperties
Dim hasAttachPath As New ExchangeWebServices.PathToUnindexedFieldType
hasAttachPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemHasAttachments
Dim attachmentsPath As New ExchangeWebServices.PathToUnindexedFieldType
attachmentsPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemAttachments
' Add additional properties?
getItemRequest.ItemShape.AdditionalProperties = New ExchangeWebServices.BasePathToElementType() { _
hasAttachPath, attachmentsPath}
Dim getItemResponse As ExchangeWebServices.GetItemResponseType = binding.GetItem(getItemRequest)
Dim getItemResponseMessage As ExchangeWebServices.ItemInfoResponseMessageType = TryCast( _
getItemResponse.ResponseMessages.Items(0), ExchangeWebServices.ItemInfoResponseMessageType)
If getItemResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
Dim item As ExchangeWebServices.ItemType = getItemResponseMessage.Items.Items(0)
' Don't rely on HasAttachments -- it does not mean what you think it would.
If (item.Attachments IsNot Nothing) AndAlso (item.Attachments.Length > 0) Then
For attachmentIndex As Integer = 0 To item.Attachments.Length - 1
Dim almostAnAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
item.Attachments(attachmentIndex), ExchangeWebServices.FileAttachmentType)
If almostAnAttachment IsNot Nothing Then
iAttachmentCount = iAttachmentCount + 1
End If
Next
End If
End If
Return iAttachmentCount
End Function
Function MarkItemAsProcessed(esb As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType) As Boolean
Dim bReturn As Boolean = False
' Create the DeleteItem request.
Dim dit As New ExchangeWebServices.DeleteItemType
dit.ItemIds = New ExchangeWebServices.BaseItemIdType() {id}
' Delete the message.
Dim diResponse As ExchangeWebServices.DeleteItemResponseType = esb.DeleteItem(dit)
' Check the result.
If (diResponse.ResponseMessages.Items.Length > 0) AndAlso _
(diResponse.ResponseMessages.Items(0).ResponseClass = _
ExchangeWebServices.ResponseClassType.Success) Then
bReturn = True
End If
Return bReturn
End Function
Sub GetAttachmentsOnItem(binding As ExchangeWebServices.ExchangeServiceBinding, _
id As ExchangeWebServices.ItemIdType, _
destinationPath As String)
' STEP 1: We need to call GetItem on the Id so that we can get the Attachments collection back.
Dim getItemRequest As New ExchangeWebServices.GetItemType
getItemRequest.ItemIds = New ExchangeWebServices.ItemIdType() {id}
getItemRequest.ItemShape = New ExchangeWebServices.ItemResponseShapeType
' For this example, all we really need is the HasAttachments property and the Attachment collection.
' As such, let's just request those properties to reduce network traffic.
getItemRequest.ItemShape.BaseShape = ExchangeWebServices.DefaultShapeNamesType.IdOnly
Dim hasAttachPath As New ExchangeWebServices.PathToUnindexedFieldType
hasAttachPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemHasAttachments
Dim attachmentsPath As New ExchangeWebServices.PathToUnindexedFieldType
attachmentsPath.FieldURI = ExchangeWebServices.UnindexedFieldURIType.itemAttachments
' Add these to the list of properties to fetch....
getItemRequest.ItemShape.AdditionalProperties = New ExchangeWebServices.BasePathToElementType() { _
hasAttachPath, attachmentsPath}
' Now make the call.
Dim getItemResponse As ExchangeWebServices.GetItemResponseType = binding.GetItem(getItemRequest)
' getItem returns ItemInfoResponseMessages. Since we only requested one item, we should only
' get back one response message.
Dim getItemResponseMessage As ExchangeWebServices.ItemInfoResponseMessageType = TryCast( _
getItemResponse.ResponseMessages.Items(0), ExchangeWebServices.ItemInfoResponseMessageType)
' Like all good, happy and compliant developers [sic], we should check our response code....
If getItemResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
' STEP 2: Grab the Attachment IDs from our item
Dim item As ExchangeWebServices.ItemType = getItemResponseMessage.Items.Items(0)
If item.HasAttachments AndAlso item.Attachments IsNot Nothing AndAlso item.Attachments.Length > 0 Then
Dim attachmentIds As New List(Of ExchangeWebServices.RequestAttachmentIdType)
For attachmentIndex As Integer = 0 To item.Attachments.Length - 1
' For now, let's only consider file attachments instead of item attachments.
Dim almostAnAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
item.Attachments(attachmentIndex), ExchangeWebServices.FileAttachmentType)
If almostAnAttachment IsNot Nothing Then
' VERY IMPORTANT! The attachment collection returned by GetItem only has meta data
' about the attachments, but DOES NOT INCLUDE THE ACTUAL CONTENT. We must use
' GetAttachment to get the actual attachment.
Dim requestId As New ExchangeWebServices.RequestAttachmentIdType
requestId.Id = almostAnAttachment.AttachmentId.Id
attachmentIds.Add(requestId)
End If
Next
' Now that we have all of the attachment IDs, let's make a single GetAttachment call to
' get them all in one shot.
Dim getAttachmentRequest As New ExchangeWebServices.GetAttachmentType
' Oddly enough, just create an EMPTY (non-null) attachment response shape.
getAttachmentRequest.AttachmentShape = New ExchangeWebServices.AttachmentResponseShapeType
getAttachmentRequest.AttachmentIds = attachmentIds.ToArray()
Dim getAttachmentResponse As ExchangeWebServices.GetAttachmentResponseType = _
binding.GetAttachment(getAttachmentRequest)
' Now, here we asked for multiple items. As such, we will get back multiple response
' messages.
For Each attachmentResponseMessage As ExchangeWebServices.AttachmentInfoResponseMessageType _
In getAttachmentResponse.ResponseMessages.Items
If attachmentResponseMessage.ResponseCode = ExchangeWebServices.ResponseCodeType.NoError Then
' We only asked for file attachments above, so we should only get FileAttachments.
' If you are really paranoid, you can check for null after this again.
Dim fileAttachment As ExchangeWebServices.FileAttachmentType = TryCast( _
attachmentResponseMessage.Attachments(0), ExchangeWebServices.FileAttachmentType)
' Now, just save out the file contents.
Using file As System.IO.FileStream = System.IO.File.Create(System.IO.Path.Combine(destinationPath, fileAttachment.Name))
file.Write(fileAttachment.Content, 0, fileAttachment.Content.Length)
file.Flush()
file.Close()
End Using
End If
Next
End If
End If
End Sub
End Module
End Namespace
One final note: You will use the same .asmx link both to create the web reference to EWS and to connect to the server to make the actual calls. This had me stumped for a bit.
Good luck!
I'm in the process of writing a little app for our SQL developers to allow them to create labels with TFS for easy code deployment, the trouble is the .ssmssqlproj files are being added to the label when ever i create one. I've added a sub to loop through and unlabel these file but i just will not work. code below
Public Sub UnlabelItem()
Dim returnValue As LabelResult()
Dim labelName As String = "1208-2210"
Dim labelScope As String = "$/"
Dim version As VersionSpec = New LabelVersionSpec(labelName, labelScope)
Dim path As String = "$/FEPI/Database/FEPI/000 Pre Tasks.ssmssqlproj"
Dim recursion As RecursionType = RecursionType.None
Dim itemspec As ItemSpec = New ItemSpec(path, recursion)
returnValue = sourceControl.UnlabelItem(labelName, labelScope, itemspec, version)
End Sub
this is a test Sub just to get it working and this is the error i get
Value of type 'Microsoft.TeamFoundation.VersionControl.Client.ItemSpec' cannot be converted to '1-dimensional array of Microsoft.TeamFoundation.VersionControl.Client.ItemSpec'
HAs anybody had any luck with the unlabel command?
Matt
So I have a view (object name is 'view') in a Lotus Domino db from which I want to grab the column names and put them in an array:
Dim view As Domino.NotesView
Set view = db.GetView(viewScen)
//viewScen is a string containing the actual view's name
//db is a string containing the actual db name
These declarations work fine, but when I try to assign those values to an array using the method called 'getColumnNames', the VBA editor tells me that the method is not supported for that object:
Dim someArray() As String
//I tried both of the following with no sucess...
someArray = view.getColumnNames
someArray() = view.getColumnNames
What am I doing wrong?
I think you can do a For..Each with columns
dim idx as integer
dim OneCol as Column
redim someArray(view.Columns.Count)
For idx = 0 to view.Columns.Count - 1
someArray(idx) = view.Columns(idx).name
Next
According to the 8.0 help files, the getColumnNames method is not supported in COM/OLE. However, the attribute ColumnNames is supported. This is VB code from the Help file:
Private Sub ViewColumnNames_Click()
Dim s As New NotesSession
s.Initialize
Dim dir As NotesDbDirectory
Dim db As NotesDatabase
Dim v As NotesView
Dim cns As String
Set dir = s.GetDbDirectory("")
Set db = dir.OpenDatabase("Web test")
Set v = db.GetView("Main View")
For Each cn In v.ColumnNames
cns = cns + cn + Chr(10)
Next
MsgBox cns, , "Columns in Main View"
End Sub
I'm using open source component to retrieve emails from my mail server using vb.net (pop3)
but because i have a lot of messages it gives me response Time out and i think if i just got the new messages it will make reading faster.
this is my code:
Dim popp As New Pop3Client("user#mail.com", "*******", "pop3.mail.com")
popp.AuthenticateMode = Pop3AuthenticateMode.Pop
popp.Port = 110
'popp.Ssl = True
popp.Authenticate()
Dim msglist As New List(Of String)
If popp.State = Pop3ConnectionState.Authenticated Then
Dim totalmsgs As Integer = popp.GetTotalMessageCount()
If totalmsgs > 0 Then
For index As Integer = 1 To totalmsgs
Dim msg As Pop3Message = popp.GetMessage(index)
msglist.Add(msg.Subject)
Next
popp.Close()
End If
End If
Return msglist
please i need some help if i'm using the component in a wrong way or if there is another component do what i'm looking for.
b.s. : my component name is "Higuchi.Mail.dll" or "OpenPOP.dll" and the two are same.
thanks
POP3 does not have the capibility to track whether messages are read or unread. I would suggest you set your limit to a finite number such as 50 or 100. Perhaps you could do some sort of pagination system.
This code needs to be within a function so that you can call it like so:
Sub Main
Dim start As Integer = Integer.parse(Request.QueryString("start"))
Dim count As Integer = Integer.parse(Request.QueryString("count"))
Dim subjects As New List(Of String)
subjects = getSubjects(start, count)
'Do whatever with the results...
'
End Sub
Function getSubjects(ByVal startItem As Integer, ByVal endItem as Integer) As List(Of String)
Dim popp As New Pop3Client("user#mail.com", "*******", "pop3.mail.com")
popp.AuthenticateMode = Pop3AuthenticateMode.Pop
popp.Port = 110
popp.Authenticate()
Dim msglist As New List(Of String)
If popp.State = Pop3ConnectionState.Authenticated Then
Dim totalmsgs As Integer = popp.GetTotalMessageCount()
Dim endItem As Integer = countItems + startItem
If endItem > totalmsgs Then
endItem = totalmsgs
End If
If totalmsgs > 0 Then
For index As Integer = startItem To endItem
Dim msg As Pop3Message = popp.GetMessage(index)
msglist.Add(msg.Subject)
Next
popp.Close()
End If
End If
Return msglist
End Function
Just have the program change the value for startItem to 50 get the next fifty (items 50-100)
POP3 protocol does not have the notion of seen/unseen messages.
Can't you use IMAP?
It would give you more features (like searching, flagging, folder management) than POP3.