Outlook VBA - .RTFBody Formatting from Byte Array

Outlook VBA - .RTFBody Formatting from Byte Array - arrays

I am developing a VBA / VSTO script that interacts with Outlook.
I have a process that should, essentially, do this:
Read in an .oft file that is in Rich Text Format
Parse the RTFBody array into a String
Replace some elements of the String (so a line that says "%SUBJECT%" will instead be "IMPORTANT MEETING")
Convert that String back into the RTF array format (this uses a Rich Text Box)
Replace the RTFBody with the updated RTF array
Display the finished email
This is all done. Except the finished email is just RTF garbage with no formatting.
So what is meant to be a lovely table is instead this:
{\rtf1\adeflang1025\ansi\ansicpg1252\uc1\adeff37\deff0\stshfdbch0\stshfloch37\stshfhich37\stshfbi37\deflang2057\deflangfe2057\themelang2057\themelangfe0\themelangcs0{\fonttbl{\f0\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304}Times New Roman;}{\f34\fbidi \froman\fcharset0\fprq2{\*\panose 02040503050406030204}Cambria Math;}{\f37\fbidi \fswiss\fcharset0\fprq2{\*\panose 020f0502020204030204}Calibri;}{\f31500\fbidi \froman\fcharset0\fprq2{\*\panose 02020603050405020304
(You can imagine the rest.)
The code is:
Dim objMsg As AppointmentItem
' 1. Read in an .oft file that is in Rich Text Format
objMsg = Application.CreateItemFromTemplate(currentLocation & "\template.oft")
' 2. Parse the RTFBody array into a String
Dim rtfArray = objMsg.RTFBody
Dim Encoding = New System.Text.ASCIIEncoding()
Dim rtfBody = Encoding.GetString(rtfArray)
' 3. Replace some elements of the String (so a line that says "%SUBJECT%" will instead be "IMPORTANT MEETING")
rtfBody = Replace(rtfBody, "%SUBJECT%", "Important Meeting")
' 4. Convert that String back into the RTF array format (this uses a Rich Text Box)
Dim rtb = New System.Windows.Forms.RichTextBox()
rtb.Text = rtfBody
Dim newArray = System.Text.Encoding.ASCII.GetBytes(rtb.Rtf)
'5. Replace the RTFBody with the updated RTF array
objMsg.RTFBody = newArray
'6. Display the finished email
objMsg.Display()
Does anyone have any awareness of what the solution to this problem is?
And before anyone suggests HTML... I would love to! But this is an AppointmentItem so it doesn't support HTMLBody.

To parse the RTFBody array into a string you have dealt with ASCII encoded string:
Dim rtfArray = objMsg.RTFBody
Dim Encoding = New System.Text.ASCIIEncoding()
Dim rtfBody = Encoding.GetString(rtfArray)
But to set the RTFBody you deal with UTF8 for an unknown reason:
Dim newArray = System.Text.Encoding.UTF8.GetBytes(rtb.Rtf)
Try to use the same encoding:
Dim newArray = System.Text.Encoding.ASCII.GetBytes(rtb.Rtf)
Be aware, The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. See Chapter 17: Working with Item Bodies for more information.
Note, the MailItem.BodyFormat property allows you to programmatically change the editor that is used for the body of an item.

Related

How to parse and address a json matrix array in Excel-VBA?

I need to parse JSON text to a JSON object in Excel-VBA. The JSON text includes a matrix/array. Then I need to address it (set a VBA variable to the value).
My code had been working parsing a nested/keyed JSON text with "JsonConverter.parseJSON" method. But I do not know how to address new array object (or technically if the "parse" is working correctly.
Dim jsonResults As String
Dim jsonObj As Dictionary
Set travelDist As Number
Set jsonResults = '{"distances":[[0,97641],[97415,0]],"times":[[0,4189],[4183,0]],"weights":[[0.0,5653.726],[5644.176,0.0]],"info":{"copyrights":["GraphHopper","OpenStreetMap contributors"]}}'
Set jsonObj = JsonConverter.ParseJson(jsonResults) \This worked with the old JSON text keyed value structure.
travelDist = VBA.Val(jsonObj.Item("distances")(1)) \This DOESN'T work. It worked with Keyed Object Values. The goal is to set travelDist to in this example, 97641.
The current code seems to have a type mismatch.
The goal is to set a VBA variable to 97641. Please let me know how to include required files/definitions etc. if the solution is including additional types or methods.

There's no reason to declare jsonObj as a dictionary and unless Number is a well defined user-defined type of some sort, I don't think declaring travelDist as Number will work. Use Double instead. And always use Option Explicit on the very top.
Also the double quotes in the JSON string need to be escaped somehow. You can either double them:
jsonResults = "{""distances"":[[0,97641],[97415,0]],""times"":[[0,4189],[4183,0]],""weights"":[[0.0,5653.726],[5644.176,0.0]],""info"":{""copyrights"":[""GraphHopper"",""OpenStreetMap contributors""]}}"
or replace them with single quotes:
jsonResults = "{'distances':[[0,97641],[97415,0]],'times':[[0,4189],[4183,0]],'weights':[[0.0,5653.726],[5644.176,0.0]],'info':{'copyrights':['GraphHopper','OpenStreetMap contributors']}}"
or you can just store the string in a cell in one of your worksheets and load it from there:
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Name of your Worksheet")
Set jsonObj = JsonConverter.ParseJson(sht.Range("A1"))
Visualizing the JSON structure might help you understand it better:
So basically what you need to do is access the 2nd item, of the 1st item, of the distances array/collection, keeping in mind that the 1st item of the distances array is also an array/collection itself.
The way to do this would be the following:
Option Explicit
Sub test()
Dim jsonObj As Object
Dim jsonResults As String
Dim travelDist As Double
jsonResults = "{""distances"":[[0,97641],[97415,0]],""times"":[[0,4189],[4183,0]],""weights"":[[0.0,5653.726],[5644.176,0.0]],""info"":{""copyrights"":[""GraphHopper"",""OpenStreetMap contributors""]}}"
Set jsonObj = JsonConverter.ParseJson(jsonResults)
travelDist = jsonObj("distances")(1)(2)
Debug.Print travelDist 'the result is printed in the immediate window
End Sub
Finally, I assume that since you've used this before, you know you need to add this JSON parser to your project, as well as a reference to Microsoft Scripting Runtime (VBE>Tools>References>...)

Allow edits from different users appear in different color inside memo box : Microsoft Access 2010

I have a memo field which contains rich text. I am able to identify a user and change all the text in the box instead of just the text they added.
I am looking to write code which allows the text to be edited and after update , the edited text will appear a different color than the original text in the memo field.
I have tried :
Dim strNew As String
Dim strOld As String
If Me.txt_username_id = "grant" Then
strOld = Me.Form!txtnotesaboutproduct1.OldValue.ForeColor = vbBlack<br/>
strNew = Me.Form!txtnotesaboutproduct1.ForeColor = vbRed
End If
I have also tried
Dim ctlOld As TextBox<br/>
Set ctlOld = Me.Form!txtnotesaboutproduct1
If Me.txt_username_id = "grant" Then
ctlOld = Me.Form!txtnotesaboutproduct1.OldValue.ForeColor = vbRed
End If

Generally, I do this with a continuous subform for Notes, so that I can hold the data, date and user, rather than just one formatted text box. Though I do realize this might be a lot more real estate that you might have, you can use a conditional format within the subform. I do agree that if it is possible, you'll likely need to use HTML and not .Forecolor, which will change the entire box.

Populating an array from a text file

So I'm trying to populate an array from a text file. I'm in Visual Basic (which I haven't touched in over a year, and have very limited knowledge from a High School course.) I have the text being read and I attempted to put it into an array from various other resources online, except that the array isn't really being read. The last value in the text file is the value that's being stored, and I'm not really sure how to fix it. Here is the code I have so far:
Dim sr As New StreamReader("text file location")
Dim words(292) As String
Dim text as String = ""
Dim i As Integer = 0
Do Until sr.Peek = -1
text = sr.ReadLine()
words(i) = text
lstWords.Items.Add(words(i))
Loop
I'm new to the StackOverFlow community, and would love some help from anyone who is able to give it! Thank you in advance!

You're doing it the hard way. Try this:
Dim words() As String = File.ReadAllLines("text file location")
And since you're loading a listbox:
lstWords.Items.AddRange(File.ReadAllLines("text file location"))

Visual Basic Array text file

I'm trying to attach a text file with my data for an array Visual Basic, in Visual Studio 2012.
How do you deliminate new values in the array? I've tried new lines, commas, quotes and it still reads it all as
arrayname(0)

You probably need a split() function. How is the text file organized? Are all the values separated by newlines?
Dim arrayname() As String
Dim text_string As String
text_string = "whatever you need to import from text file"
arrayname() = Split(text_string, " ") 'example splitting using spaces
output:
arrayname(0) = "whatever"
arrayname(1) = "you"
...

I figured it out
Dim Arrayname() As type = My.Resources.ResourceName.Split(Environment.NewLine)

How can I import records from a text file (not delimited) in access db?

I am just trying figure out a record import program from text file into access database using Microsoft.Jet.Oledb Provider 4.0 and Vb.net. And it seems easy but my problem is different. In the text file, records are not delimited. I am a newbie so it became too hard for me. Please give some hint to solve this issue.
Format of the text file:
Field Name & Size
Date[Date,ShortDate]FirstName[20]LastName[20]Sex[1]Age[2]
Records
02062011john……………..little………………M15
…
…
…
Can I put delimiter programmatically while reading the text file using stream reader and later simply import the whole file in DB. Any suggestions

One option is to use the TextFieldParser class:
http://msdn.microsoft.com/en-us/library/microsoft.visualbasic.fileio.textfieldparser.aspx
Imports Microsoft.VisualBasic.FileIO
Private Sub ReadFixedWidthText()
Dim theString As String = "John Little M15" + vbCrLf + "Jane Doe F30"
Using rdr As New StringReader(theString)
Using parser As New TextFieldParser(rdr)
parser.TextFieldType = FieldType.FixedWidth
parser.FieldWidths = New Integer() {20, 20, 1, 2}
parser.TrimWhiteSpace = True
While Not parser.EndOfData
Dim fields() As String = parser.ReadFields()
For i As Integer = 0 To fields.Length - 1
Console.WriteLine("Field {0}: {1}", i, fields(i))
Next
End While
End Using
End Using
End Sub
I used a StringReader in this example, but you could just as easily use a StreamReader or just use the filename in the TextFieldParser constructor.
Or you could use a combination of the StreamReader and the String.Substring method to get the individual fields.

Is it not space delimited? Do you have any constraints on text file like for example from first character till 100th character is first name etc? If yes you can break the text on the basis of those constraints.