skip to Main Content

I’m trying to replicate a VBA function I made into VB.NET.
it basically gets a mail and then it extracts its TABLE tag from its HTMLBody.
My issue is that the functions give a different output.
VBA’s returns a standard HTML format, with all the tags, TABLE included.
VB.NET’s output instead is the one below.

<!-- Converted from text/rtf format -->
<P><FONT SIZE=2>TEXT0,<BR>
<BR>
<BR>
INTRO:<BR>
<BR>
A. TEXT1<BR>
<BR>
B TEXT2<BR>
<BR>
C. TEXT3<BR>
<BR>
D. TEXT4<BR>
<BR>
E. TEXT5 &amp; TEXT6<BR>
<BR>
<BR>

This instead what I would like to have

<body lang=EN-US link=blue vlink=purple style='word-wrap:break-word'><div class=WordSection1><p><span style='font-family:Arial'>TEXT0<o:p></o:p></span></p>
<p><span style='font-family:Arial'><br>INTRO <o:p></o:p></span></p>
<p><span style='font-family:Arial'>A. TEXT1 <o:p></o:p></span></p>
<p><span style='font-family:Arial'>B. TEXT2 <o:p></o:p></span></p>
<p><span style='font-family:Arial'>C. TEXT3 <o:p></o:p></span></p>
<p><span style='font-family:Arial'>D. TEXT4 <o:p></o:p></span></p>
<p style='margin-bottom:12.0pt'><span style='font-family:Arial'>E. TEXT5

I already tried all the BodyFormats, the result is almost the same, no standard HTML.
The references used in both are the same.
Below the code.

Function GetMailTable(Subject As String, daysAgo As Integer, ParamArray Keywords() As Object)
    Dim myOlApp As New Outlook.Application
    Dim objNamespace As Outlook.NameSpace = myOlApp.GetNamespace("MAPI")
    Dim objFolder As Outlook.MAPIFolder = objNamespace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    Dim itm As Outlook.MailItem
    Dim Found As Boolean
    Dim strFilter As String
    Dim Subj As String = Subject
    Dim arrList As ArrayList = New ArrayList
    daysAgo = myDate.Subtract(previousBusinessDay(myDate, daysAgo)).TotalDays
    strFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:subject" & Chr(34) & " like '%" & Subj & "%'"
    Dim filtereditemssubj As Object = objFolder.Items.Restrict(strFilter)
    Dim filteredItems As Object = filtereditemssubj.Restrict("[ReceivedTime]>'" & Format(myDate.AddDays(-daysAgo), "dd/MM/yyyy") + " 00:00" & "'")
    filteredItems = filteredItems.Restrict("[ReceivedTime]<'" & Format(myDate.AddDays(-daysAgo).AddDays(1), "dd/MM/yyyy") + " 00:00" & "'")
    Dim htmlDoc As New mshtml.HTMLDocument
    Dim tables As mshtml.DispHTMLElementCollection
    Dim Table As mshtml.HTMLTable
    If filteredItems.Count = 0 Then
        Found = False
    Else
        Found = True
        For Each itm In filteredItems
            htmlDoc.HTMLBody = itm.HTMLBody
            tables = htmlDoc.getElementsByTagName("table")
            For Each Table In tables
                arrList.Add(Table)
            Next Table
        Next itm
    End If
    myOlApp = Nothing
    Return arrList
End Function

You can try to replicate it including a table sample in a mail body.
Has anyone a suggestion?

Thanks everyone

2

Answers


  1. Community wiki because this probably won’t fully solve the problem (probably going to give the same result), but it’s also too long for a comment. The code below re-writes some things for modern VB.Net. If this is still just an Office add-in you might not be able to use all these language features, but some of the changes (like not using ArrayList or hungarian variable prefixes) have been standard practice for more than 15 years, and it has NEVER been needed or at all helpful with .Net to set items to Nothing at the end of a method.

    Function GetMailTable(Subject As String, daysAgo As Integer, ParamArray Keywords() As Object) As IEnumerable(Of mshtml.HTMLTable)
        Dim App As New Outlook.Application()
        Dim Mapi As Outlook.NameSpace = App.GetNamespace("MAPI")
        Dim Inbox As Outlook.MAPIFolder = Mapi.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    
        Dim searchDate As DateTime = DateTime.Today.AddDays(-daysAgo) 
        Dim quote As String = Chr(34)
        ' Below line assumes "Option Infer On"
        Dim filteredItems = Inbox.Items.
                       Restrict($"@SQL={quote}urn:schemas:httpmail:subject{quote} like '%{Subject}%'").
                       Restrict($"[ReceivedTime]>'{searchDate:dd/MM/yyyy HH:mm}'")
       
        ' Needs "Imports System.Linq" at the top
        Return filteredItems.
            Select(Function(itm) New mshtml.HTMLDocument With {.HTMLBody = itm.HTMLBody}).
            SelectMany(Function(doc)  doc.getElementsByTagName("table")).
            Cast(Of mshtml.HTMLTable)()
    End Function
    

    Also, the Keywords argument was never used. I only left it in case there’s code somewhere calling the method that might break if the parameter was not defined.

    Of course calling code must also adjust for the new return type. The new result can be used with a For Each loop, with the Linq operator methods, or as a list by appending .ToList() to the function call. Try to avoid the last one as much as possible.

    Finally, if the filteredItems type, which I can’t see, doesn’t formally implement the right interface, you may need to include this method (in a separate class or module):

    ' Requires Option Strict Off, so the compiler will make the implied GetEnumerator() call :(
    <Extension()> 
    Public Shared Iterator Function AsEnumerable(Of T)(input As Object) As IEnumerable(Of T)
        For Each item As T In input.GetEnumerator()
            Yield item
        Next
    End Function
    

    And then the first line of the Return statement like would look like this:

    Return filteredItems.AsEnumerable(Of Outlook.MailItem)().
    

    We know filteredItems will have the required GetEnumerator() method, or it wouldn’t have worked with a For Each loop in the original code. It’s also possible explicitly typing the initial filteredItems variable declaration would work to avoid this, but if you run into this problem at all I don’t think it will help.

    Login or Signup to reply.
  2. The HTML indicates that the message is plain text or RTF, not HTML. Most likely your script is accessing a message different from what VBA accessed.

    Try to find the right message, select it, and use Application.ActiveExplorer.Selection collection instead of the restricted Items collection as a test.

    Login or Signup to reply.
Please signup or login to give your own answer.
Back To Top
Search