none
OfficeHelper class by William Stacey - help convert to vb.net RRS feed

  • Question

  • Need some help in order to convert OfficeHelper class by William Stacey http://ourbizforward.com/IdeaFactory/post/2011/11/22/LightSwitch-Office-(Word-and-Outlook)-Helper.aspx to vb.net

    I used http://www.developerfusion.com/tools/convert/csharp-to-vb/ in order to convert the class but i can't convert the second part (Screen example code /Usage Example).

    does anyone have a working example in VB.net?thanks

    'deleted line 170 in order to convert from c# to vb.net
    'http://ourbizforward.com/IdeaFactory/post/2011/11/22/LightSwitch-Office-(Word-and-Outlook)-Helper.aspx
    Imports System.Collections
    Imports System.Collections.Generic
    Imports System.IO
    Imports System.Reflection
    Imports System.Runtime.InteropServices.Automation
    Imports System.Text
    Imports Microsoft.LightSwitch.Threading
    Imports System.Linq
    
    Namespace LightSwitchApplication.UserCode
        Public NotInheritable Class OfficeHelper
            Private Sub New()
            End Sub
            ''' <summary>
            ''' Open outlook message passing fields.
            ''' </summary>
            Public Shared Function OpenOutlook([to] As String, cc As String, subject As String, attachment As String, table As IEnumerable, fields As IEnumerable(Of FieldMapping)) As Object
                ' Example: http://www.devcurry.com/2011/05/silverlight-4-and-com-sending-mails.html
                Dim outlook = AutomationFactory.CreateObject("Outlook.Application")
                Dim mail = outlook.CreateItem(0)
                mail.[To] = [to]
                mail.Cc = cc
                mail.Subject = subject
                'mail.Body = GetHtml();
                mail.Attachments.Add(attachment)
                Dim html As String = GetHtmlTable(table, fields)
                mail.HTMLBody = html
                mail.Display()
                Return outlook
            End Function
    
            ''' <summary>
            ''' Open MS Word passing values to content controls.
            ''' </summary>
            Public Shared Function OpenWord(wordPath As String, entityName As String, entity As Object, fields As IEnumerable(Of FieldMapping)) As Object
                If Not File.Exists(wordPath) Then
                    wordPath = GetWordFileFromDialog()
                End If
                If Not File.Exists(wordPath) Then
                    Return Nothing
                End If
                Dim xmlPart As String = GetXMLPart(entityName, entity, fields)
                OpenDocAndAddXmlPart(wordPath, entityName, xmlPart)
                Return Nothing
            End Function
    
            Private Shared Function OpenDocAndAddXmlPart(wordPath As String, entityName As String, xmlPart As String) As Object
                If Not AutomationFactory.IsAvailable Then
                    Return Nothing
                End If
                Try
                    Dim word = AutomationFactory.CreateObject("Word.Application")
                    Dim doc = word.Documents.Open(wordPath)
    
                    ' Add xml part to document.
                    Dim customXMLPart = doc.CustomXMLParts.Add(xmlPart)
    
                    ' Bind any content controls that we find to the xml data element of same name.
                    For i As Integer = 1 To doc.ContentControls.Count
                        Dim ctrl = doc.ContentControls(i)
                        Dim mapping As String = String.Format("root[1]/{0}[1]/{1}[1]", entityName, ctrl.Title.ToString())
                        ctrl.XMLMapping.SetMapping(mapping, Nothing, customXMLPart)
                    Next
                    word.Visible = True
                    Return word
                Catch ex As Exception
                    Throw New InvalidOperationException("Failed to create word.", ex)
                End Try
            End Function
    
            Private Shared Function GetWordFileFromDialog() As String
                Return GetFile("Word Files (*.docx)|*.docx")
            End Function
    
            Private Shared Function GetFile(filter As String) As String
                Dim file As System.IO.FileInfo = Nothing
                Dispatchers.Main.Invoke(Sub()
                                            Dim dlg As New System.Windows.Controls.OpenFileDialog()
                                            dlg.Filter = filter
    
                                            If dlg.ShowDialog() = True Then
                                                file = dlg.File
                                            End If
                                        End Sub)
    
                If file IsNot Nothing Then
                    Return file.FullName
                End If
                Return ""
            End Function
    
            ''' <summary>
            ''' Get field value on object using reflection.
            ''' </summary>
            ''' <param name="c"></param>
            ''' <param name="name"></param>
            ''' <returns></returns>
            Private Shared Function GetFieldValue(c As Object, name As String) As Object
                Dim t As Type = c.[GetType]()
                Dim pi As PropertyInfo = t.GetProperty(name, BindingFlags.IgnoreCase Or BindingFlags.[Public] Or BindingFlags.Instance)
                Dim value As Object = Nothing
                Try
                    value = pi.GetValue(c, Nothing)
                Catch
                End Try
                ' Ignore, does not exist, so return null.
                Return value
            End Function
    
            ''' <summary>
            ''' Return an xml part using a single entity.
            ''' </summary>
            Public Shared Function GetXMLPart(entityName As String, entity As Object, fields As IEnumerable(Of FieldMapping)) As String
                Return GetXMLPart(entityName, New Object() {entity}, fields)
            End Function
    
            ''' <summary>
            ''' Return an xml part using a collection of entities.
            ''' </summary>
            Public Shared Function GetXMLPart(entityName As String, entityList As IEnumerable, fields As IEnumerable(Of FieldMapping)) As String
                Dim defConv As Func(Of Object, String) = Function(o As Object) o.ToString()
                Dim sb As New StringBuilder()
    
                ' Add root.
                sb.Append("<root>" & vbLf)
    
                ' Add table data rows.
                For Each row In entityList
                    sb.AppendFormat("<{0}>" & vbLf, entityName)
    
                    For Each fm In fields
                        Dim value As Object = GetFieldValue(row, fm.Name)
                        Dim sValue As String = If(fm.Converter Is Nothing, defConv(value), fm.Converter(value))
                        sValue = EscapeXmlData(sValue)
                        Dim element As String = String.Format("<{0}>{1}</{0}>" & vbLf, fm.Title, sValue)
                        sb.Append(element)
                    Next
    
                    sb.AppendFormat("</{0}>" & vbLf, entityName)
                Next
    
                ' Add end of part.
                sb.Append("</root>" & vbLf)
                Return sb.ToString()
            End Function
    
            Private Shared Function EscapeXmlData(value As String) As String
                If value Is Nothing Then
                    Return ""
                End If
                ' SB may be more efficient as not creating new string for each replace.
                Dim sb As New StringBuilder(value)
                ' Replace amps first.
    
                sb.Replace("&", "&").Replace("<", "<").Replace(">", ">").Replace("'", "&apos;")
                Return sb.ToString()
            End Function
    
            ''' <summary>
            ''' Creates an HTML table by picking passed fields from the list.
            ''' </summary>
            ''' <param name="list"></param>
            ''' <param name="fieldList"></param>
            ''' <returns></returns>
            Private Shared Function GetHtmlTable(list As IEnumerable, fieldList As IEnumerable(Of FieldMapping)) As String
                Dim defConv As Func(Of Object, String) = Function(o As Object) o.ToString()
                Dim sb As New StringBuilder()
    
                ' Add table header row.
                sb.AppendLine("<html><body><div><table border=""1"">")
                Dim headerRow As String = GetHtmlTableRow(fieldList.[Select](Function(fi) fi.Title))
                sb.AppendFormat(headerRow)
    
                ' Add table data rows.
                For Each row In list
                    Dim cols = fieldList.[Select](Function(fi)
                                                      Dim value As Object = GetFieldValue(row, fi.Name)
                                                      Return If(fi.Converter Is Nothing, defConv(value), fi.Converter(value))
    
                                                  End Function)
                    sb.Append(GetHtmlTableRow(cols))
                Next
    
                ' Add end of table.
                sb.AppendLine("</table></div></body></html>")
                Return sb.ToString()
            End Function
    
            ''' <summary>
            ''' Returns an html table row from the string values passed.
            ''' </summary>
            ''' <param name="values"></param>
            ''' <returns></returns>
            Private Shared Function GetHtmlTableRow(values As IEnumerable(Of String)) As String
                Dim sb As New StringBuilder()
                sb.Append("<tr>")
                For Each s As String In values
                    sb.AppendFormat("<td>{0}</td>", s)
                Next
                sb.Append("</tr>")
                Return sb.ToString()
            End Function
        End Class
    
        ''' <summary>
        ''' Map entity information to targets.
        ''' </summary>
        Public Class FieldMapping
            Private _title As String
            Public Property Title() As String
                Get
                    If _title Is Nothing Then
                        Return Name
                    End If
                    Return _title
                End Get
                Set(value As String)
                    Me._title = value
                End Set
            End Property
            Public Property Name() As String
                Get
                    Return m_Name
                End Get
                Set(value As String)
                    m_Name = Value
                End Set
            End Property
            Private m_Name As String
            Public Property Converter() As Func(Of Object, String)
                Get
                    Return m_Converter
                End Get
                Set(value As Func(Of Object, String))
                    m_Converter = Value
                End Set
            End Property
            Private m_Converter As Func(Of Object, String)
    
            Public Sub New(name As String, Optional title As String = Nothing, Optional converter As Func(Of Object, String) = Nothing)
                Me.Name = name
                Me._title = title
                Me.Converter = converter
            End Sub
    
            Public Sub New(name As String, title As String, format As String)
                If format Is Nothing Then
                    format = ""
                End If
                Me.Name = name
                Me._title = title
                Me.Converter = Function(ob As Object)
                                   Return String.Format("{0:" & format & "}", ob)
    
                               End Function
            End Sub
        End Class
    End Namespace

    Thursday, February 16, 2012 3:44 PM

Answers

  • I don't have the toolkit installed, but this should be what you need:

    Private Sub OpenWord_Execute()
        Dim mapFields = New FieldMapping() _
            { _
                New FieldMapping("FirstName", "First"), _
                New FieldMapping("LastName", "Last"), _
                New FieldMapping("PhoneNumber", "Phone", _
                    Function(p As Object)
                        Dim phone = TryCast(p, String)
                        Dim num = 0
    
                        If (Long.TryParse(phone, num)) Then
                                    Return num.ToString("# (###) ###-####").TrimStart()
                        Else
                            Return phone
                        End If
                    End Function),
                New FieldMapping("Picture", Nothing, _
                    Function(obj As Object)
                        Dim ba = TryCast(obj, Byte())
    
                        If (ba Is Nothing) Then
                            Return Nothing
                        Else
                            Return Convert.ToBase64String(ba)
                        End If
                    End Function),
                New FieldMapping("Cost", Nothing, "C2") _
            }
    
        ' Open Word and fill xmlPart with selected fields.    
        Dim wordPath As String = Environment.GetFolderPath(Environment.SpecialFolder.MyDocuments) & "\AuthorsTemp.docx"
        OfficeHelper.OpenWord(wordPath, "Author", Me.Authors.FirstOrDefault(), mapFields)
    End Sub
    
    Those function lambdas sure confuse most converters. I had to do it by hand. Let me know if I didn't get it quite right, but it looks right to me.

    Yann - LightSwitch Central - Click here for FREE Themes, Controls, Types and Commands
     
    If you find a reply helpful, please click "Vote as Helpful", if a reply answers your question, please click "Mark as Answer"
     
    By doing this you'll help people find answers faster.

    • Marked as answer by tsiakk Friday, February 17, 2012 1:29 PM
    Friday, February 17, 2012 1:51 AM
    Moderator