Create a plain text message with Exchange 2013 - outlook-redemption

I am trying to send a plain text message every time I create a message it changes to HTML format.
I am using PowerShell v5 with CDO 1.2.1 with Redemption v5.19 and connecting to Exchange 2013.
I am creating an IPM.Note and setting the bodyformat to 1 (plain text), however as soon as I add any text to the body the bodyformat value changes to 2 (HTML). Once bodyformat is set to 2 I cannot change the value back.
$rs = New-Object -ComObject "Redemption.RDOSession"
$rsOutbox = $rs.GetDefaultFolder(4)
$msg = $rsOutbox.items.add("IPM.Note")
$msg.BodyFormat = 1
$msg.body = "Test"

You can try to set the RTFBody instead to a string that explicitly specifies plain text body:
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set folder = Session.GetDefaultFolder(4)
set Msg = folder.Items.Add
Msg.To = "user#example.com.com"
Msg.Subject = "testing body format"
Msg.RTFBody = "{\rtf1\ansi\ansicpg1252\fromtext \fbidis \deff0{\fonttbl " & _
"{\f0\fswiss Arial;}" & _
"{\f1\fmodern Courier New;}" & _
"{\f2\fnil\fcharset2 Symbol;}" & _
"{\f3\fmodern\fcharset0 Courier New;}}" & _
"{\colortbl\red0\green0\blue0;\red0\green0\blue255;}" & _
"\uc1\pard\plain\deftab360 \f0\fs20 Test \par" & _
"}"
Msg.BodyFormat = 1
Msg.Save

Related

Save outlook message as eml incomplete (body missing,attachments not opening,...)

I try to save outlook mails within an SQL-BLOB-Field as eml (or raw) content.
I have a form within MS Access to get the mails from outlook code:
Dim objitem As Outlook.MailItem
Set objOutlook = New Outlook.Application
Set objMapiFolder = objOutlook.Session.Folders("USER").Folders("Posteingang")
Dim inboundemail As ADODB.Recordset
Set inboundemail = New ADODB.Recordset
inboundemail.Open "Inbound_EMail_Buffer", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Set MailList = objMapiFolder.Items
Dim senderMail As String
Dim ReceiverMail As String
FillAddress
Dim SAfeMailItem
Set SAfeMailItem = CreateObject("Redemption.SafeMailItem")
For Each objitem In MailList
If objitem.Class = olMail Then
With objitem
inboundemail.AddNew
Select Case .SenderEmailType
Case "SMTP"
senderMail = .SenderEmailAddress
Case "EX"
senderMail = FindAddress(.SenderEmailAddress)
End Select
inboundemail!From = Left(Chr(34) & .SenderName & Chr(34) & " <" & senderMail & ">", 80)
inboundemail!To = .To
inboundemail!CC = .CC
inboundemail!Subject = Left(.Subject, 80)
inboundemail!DateReceived = .ReceivedTime
inboundemail!uid = .EntryId
SAfeMailItem.Item = objitem
x = SAfeMailItem.SaveAs("c:\temp\" & .EntryId & ".eml", olRFC822)
inboundemail!Size = .Size
inboundemail.Update
End With
End If
Next objitem
Me.ctlDocuments.Requery
Set objitem = Nothing
Set objOutlook = Nothing
Unfortunately the original Mail isn't saved complete
this is the mail in outlook
this is the saved .eml mail
saved eml after 5.23

Sending emails to recipients if certain cell value is met by each receipient

Basically I've used Google Sheets to create an invoice tracker, and I want to send a reminder email to each of my clients when their invoice is due. I've already set the date and the count down, and now I want to send them the reminder email when the cell value reaches "2" meaning 32 days has passed since I've invoiced them.
I've gathered the codes from different sources online, and also I've set a 24 hr trigger to run the code once in a day. The email template is also in place. Data of each client (dates, names, addresses, etc.) are listed in separate rows.
My problem is that instead of sending 1 single email to the right client, the mailing app sends emails to all clients when any of them have a due invoice!
I'm not sure which function or code I should use.
I tried 'Email_Sent' thing, but couldn't get anywhere good with it!
function CheckMaturity() {
// Fetch invoice maturity
SpreadsheetApp.getActiveSpreadsheet().getSheetByName('InvoiceTracker').activate();
var ss = SpreadsheetApp.getActiveSpreadsheet().getActiveSheet();
for (var i = 5;i<=10;i++){
var invoiceMaturityRange = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('InvoiceTracker').getRange(i, 13);
var invoiceMaturity = invoiceMaturityRange.getValue();
// Check invoice maturity
if (invoiceMaturity = 2){
// Fetch the email address
SpreadsheetApp.getActiveSpreadsheet().getSheetByName('InvoiceTracker').activate();
var templateText = SpreadsheetApp.getActiveSpreadsheet().getSheetByName('EmailTemplate').getRange(1,1).getValue();
var currentAddress = ss.getRange(i, 15).getValue();
var currentInvoiceNo = ss.getRange(i, 3).getValue();
var currentInvoiceDate = ss.getRange(i, 4).getValue();
var currentClient = ss.getRange(i, 14).getValue();
var messageBody = templateText.replace('{client}',currentClient).replace('{invoiceNo}',currentInvoiceNo).replace('{invoiceDate}', currentInvoiceDate);
var subjectLine = 'Kind reminder - Invoice status';
MailApp.sendEmail(currentAddress, subjectLine, messageBody);{
SpreadsheetApp.getActiveSpreadsheet().toast('Invoice reminder sent to' +currentClient, 'Reminder sent', -1);
}
}
}
}
I want the app to send only one single email to the right (relevant) client.
I think you need the below. Please check the variables and references. The following code should be adjusted. The column 'A' should be replaced with the column in which you have the last record to prevent that you miss any clients. Furthermore, please check the comments in the code below.
.Range("A1047854").End(xlUp).Row
And hereby the full code:
Sub SendEmails()
Dim myOlApp As Outlook.Application, MailItem As Outlook.MailItem
Dim attachmentPath1 As String, attachmentPath2 As String
Set myOlApp = CreateObject("Outlook.Application")
'loop through a sheet (change index)
For i = 1 To ThisWorkbook.Sheets("index").Range("A1047854").End(xlUp).Row
'set key for check (or just do it directly in the if)
invoiceMaturity = ThisWorkbook.Sheets("index").Range("A" & i).Value
If invoiceMaturity = "2" Then
'you can load the variables first, before adding them to the email, or add them directly.
Name = ""
MailAddress = ""
Address = ""
currentInvoiceNo = ""
currentInvoiceDate = ""
currentClient = ""
'make item for each iteration (again)
Set MailItem = myOlApp.CreateItem(olMailItem)
'attachments
attachmentPath1 = "path/to/file.something" 'or set to ""(nothing)
'body
MailItem.HTMLBody = "<B>" & "<h3>" & "DRAFT:" & "</h3>" & "</B>" & "<br>" & _
"Dear, " & "<br>" & "<br>" & _
"Please find enclosed a kind reminder.." & "<br>" & "<br>" & _
"Please note, that.." & "</b>" & "<br>" & "<br>" & _
"Should you have any questions or comments on the above, please do let us know." & "<br>" & "<br>" & _
"Kind regards," & "<br>" & "<br>" & _
"Signature"
MailItem.to = MailAddress 'adjust email
MailItem.Subject = "[subject of email" & "a variable?" 'adjust subject
MailItem.Show 'or mailitem.send
'just to make sure
Set MailItem = ""
End If
Next i
End Sub

Match Data In Two Files Then Email Each Person

For simplicity, file1.txt is a log file for which I extract logonIds into an array. File2.txt contains rows of logonID,emailAddress,other,needless,data
I need to take all of the logonIDs read into my array from file1 and extract their email addresses from file2. Once I have this information, I can then send each person in file1 an email. Can't just use file2.txt because it contains users who should not receive an email.
I wrote vbscript that extracts logonIDs from file1.txt into array and pulls logonID and email from file2.txt
inFile1 = "C:\Scripts\testvbs\wscreatestatus.txt"
inFile2 = "C:\Scripts\testvbs\WSBatchCreateBuildsList.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInFile1 = objFSO.OpenTextFile(inFile1, ForReading)
Set objInFile2 = objFSO.OpenTextFile(inFile2, ForReading)
'Creates Array of all DomainIDs for successful deployments
Do Until objInFile1.AtEndOfStream
strNextLine = objInFile1.Readline
arrLogons = Split(strNextLine , vbTab)
If arrLogons(0) = "DEPLOYSUCCESS" Then
arrUserIDList = arrUserIDList & arrLogons(5) & vbCrLf
End If
Loop
Do Until objInFile2.AtEndOfStream
strNextLine = objInFile2.Readline
arrAddressList = Split(strNextLine , ",")
arrMailList = arrMailList & arrAddressList(0) & vbTab & arrAddressList(1) & vbCrLf
Loop
What I need to do next is take my list of user IDs "arrUserIDList", and extract their email address from arrMailList. With this information I can send each user in file1.txt (wscreatestatus.txt) an email.
Thanks!
From the way you construct your arrMailList, I presume you want the selected LogonID's and corresponding email addresses output to a new Tab delimited text file.
If that is the case, I recommend using ArrayList objects to store the values in. ArrayLists have an easy to use Add method and for testing if an item is in an ArrayList, there is the Contains method.
In Code:
Option Explicit
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim inFile1, inFile2, outFile, objFSO, objInFile, objOutFile
Dim strNextLine, fields, arrUserIDList, arrMailList
inFile1 = "C:\Scripts\testvbs\wscreatestatus.txt"
inFile2 = "C:\Scripts\testvbs\WSBatchCreateBuildsList.txt"
outFile = "C:\Scripts\testvbs\WSEmailDeploySuccess.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInFile = objFSO.OpenTextFile(inFile1, ForReading)
'Create an ArrayList of all DomainIDs for successful deployments
Set arrUserIDList = CreateObject( "System.Collections.ArrayList" )
Do Until objInFile.AtEndOfStream
strNextLine = objInFile.Readline
fields = Split(strNextLine , vbTab)
If fields(0) = "DEPLOYSUCCESS" Then
arrUserIDList.Add fields(5)
End If
Loop
'close the first input file
objInFile.Close
'Now read the second file and read the logonID's from it
Set objInFile = objFSO.OpenTextFile(inFile2, ForReading)
'Create an ArrayList of all LogonID's, a TAB character and the EmailAddress
Set arrMailList = CreateObject( "System.Collections.ArrayList" )
Do Until objInFile.AtEndOfStream
strNextLine = objInFile.Readline
fields = Split(strNextLine , ",")
If arrUserIDList.Contains(fields(0)) Then
' store the values in arrMailList as TAB separated values
arrMailList.Add fields(0) & vbTab & fields(1)
End If
Loop
'close the file and destroy the object
objInFile.Close
Set objInFile = Nothing
Set objOutFile = objFSO.OpenTextFile(outFile, ForWriting, True)
For Each strNextLine In arrMailList
objOutFile.WriteLine(strNextLine)
Next
'close the file and destroy the object
objOutFile.Close
Set objOutFile = Nothing
'clean up the other objects
Set objFSO = Nothing
Set arrUserIDList = Nothing
Set arrMailList = Nothing
Hope that helps
This is how I solved my problem, but I think Theo took a better approach.
Const ForReading = 1
Const ForWriting = 2
Dim inFile1, inFile2, strNextLine, arrServiceList, arrUserList
Dim arrUserDeployList, strLine, arrList, outFile, strItem1, strItem2
inFile1 = Wscript.Arguments.Item(0) 'wscreatestatus.txt file (tab delimited)
inFile2 = Wscript.Arguments.Item(1) 'WSBatchCreateBuildsList.txt (comma delimited)
outFile = Wscript.Arguments.Item(2) 'SuccessWSMailList###.txt (for Welcome emails)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objInFile1 = objFSO.OpenTextFile(inFile1, ForReading)
Set objInFile2 = objFSO.OpenTextFile(inFile2, ForReading)
Set objOutFile = objFSO.CreateTextFile(outFile, ForWriting, True)
'Extracts Logon ID's for successfull deployments into an Array
'#================================================================
i = 0
Do Until objInFile1.AtEndOfStream
ReDim Preserve arrUsers(i)
strNextLine = objInFile1.Readline
arrLogons = Split(strNextLine , vbTab)
If arrLogons(0) = "PENDINGREQUESTS" Then
arrUsers(i) = arrLogons(5)
i = i + 1
End If
Loop
'Extracts success deploy email addresses and writes to file
'#================================================================
Do Until objInFile2.AtEndOfStream
ReDim Preserve arrMailList(i)
strNextLine = objInFile2.Readline
arrAddressList = Split(strNextLine , ",")
strItem1 = arrAddressList(0)
strItem2 = arrAddressList(1)
For Each strArrayEntry In arrUsers
If strArrayEntry = strItem1 Then
objOutFile.WriteLine strItem1 & "," & strItem2
End If
Next
i = i + 1
Loop
objOutFile.Close
objInFile1.Close
objInFile2.Close

vbscript and prncnfg.vbs inside?

I have a vbscript to get some informations about the system printing of a remote computer. I can get all the drivers installed, the default network printer name and all my results are send in a outputfile.
I want to get informations about my default network printer by the prncnfg.vbs from the printer server (driver, location, etc.) and send these informations in my outputfile.
Maybe there is an other way to do that ?
Thanks for any suggestions
So, I start to understand the way to do that. But something doesn't work.
First I need to read a file and remove 10 caracters to create my variable, this process works very well:
'Read C:\Temp\DefaultPrinter
Dim shortDefaultPrinter
If objFSO.FileExists("\"& strComputer &"\c$\Temp\DefaultPrinter.txt") then
Set objFileToRead = CreateObject("Scripting.FileSystemObject").OpenTextFile("\"& strComputer &"\c$\Temp\DefaultPrinter.txt",1)
DefaultPrinter = objFileToRead.ReadAll()
'remove text \vangogh\
shortDefaultPrinter = Right(DefaultPrinter, Len(DefaultPrinter) - 10)
'MsgBox(shortDefaultPrinter)
objFileToRead.Close
Set objFileToRead = Nothing
Second I want to use my variable shortDefaultPrinter for my query to find the location of my printer:
'Select DefaultPrinter and show location
Const ADS_SCOPE_SUBTREE = 2
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.CommandText = "Select printerName, serverName, Location from " _
& " 'LDAP://DC=huge,DC=ad,DC=hcuge,DC=ch' where objectClass='printQueue' and printerName='" & shortDefaultPrinter & "' "
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
PrinterLocation = objRecordSet.Fields("Location").Value
MsgBox(PrinterLocation)
objRecordSet.MoveNext
Loop
MsgBox doesn't open, but if I write the name of the printer in place of " & shortDefaultPrinter & ", ex dmed-i714, the process works.
Here I am. If anyone has a suggestion it would be appreciate.

How to read quoted field from CSV using VBScript

In a sample.csv file, which has fixed number of columns, I have to extract a particular field value and store it in a variable using VBScript.
sample.csv
100,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
100|SN| 435624| serkasg| 15.353|
100|SN| 437825| serkasg| 15.353|"," 0 2345"
101,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
100|SN| 435624| serkasg| 15.353|
100|SN| 437825| serkasg| 15.353|"," 0 2346"
I want to parse the last two fields which are within double quotes and store them in two different array variables for each row.
You could try using an ADO connection
Option Explicit
dim ado: set ado = CreateObject("ADODB.Connection")
ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\txtFilesFolder\;Extended Properties=""text;HDR=No;FMT=Delimited"";"
ado.open
dim recordSet: set recordSet = ado.Execute("SELECT * FROM [samples.csv]")
dim field3, field4
do until recordSet.EOF
field3 = recordSet.Fields(3).Value
field4 = recordSet.Fields(4).Value
' use your fields here
recordSet.MoveNext
loop
recordSet.close
ado.close
You may have an issue if those fields are greater than 255 characters in length - if they are, they may return truncated. You also may have better luck with ODBC or ACE connection strings instead of the Jet one I've used here.
Since CSV's are comma-separated, you can use the Split() function to separate the fields into an array:
' Read a line from the CSV...
strLine = myCSV.ReadLine()
' Split by comma into an array...
a = Split(strLine, ",")
Since you have a static number of columns (5), the last field will always be a(4) and the second-to-last field will be a(3).
Your CSV data seems to contain 2 embedded hard returns (CR, LF) per line. Then the first line ReadLine returns is:
100,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
The solution below unwraps these lines before extracting the required fields.
Option Explicit
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = 2 ' Opens the file using the system default.
Const TristateTrue = 1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Dim FSO, TextStream, Line, LineNo, Fields, Field4, Field5
ExtractFields "sample.csv"
Sub ExtractFields(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Line = ""
LineNo = 0
Set TextStream = FSO.OpenTextFile(FileName, ForReading, False, TristateFalse)
Do While Not TextStream.AtEndOfStream
Line = Line & TextStream.ReadLine()
LineNo = LineNo + 1
If LineNo mod 3 = 0 Then
Fields = Split(Line, ",")
Field4 = Fields(3)
Field5 = Fields(4)
MsgBox "Line " & LineNo / 3 & ": " & vbNewLine & vbNewLine _
& "Field4: " & Field4 & vbNewLine & vbNewLine _
& "Field5: " & Field5
Line = ""
End If
Loop
TextStream.Close()
Else
MsgBox "File " & FileName & " ... Not found"
End If
End Sub
Here is an alternative solution that allows for single or multiline CSV records. It uses a regular expression which simplifies the logic for handling multiline records. This solution does not remove CRLF characters embedded in a record; I've left that as an exercise for you :)
Option Explicit
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = 2 ' Opens the file using the system default.
Const TristateTrue = 1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Dim FSO, TextStream, Text, MyRegExp, MyMatches, MyMatch, Field4, Field5
ExtractFields "sample.csv"
Sub ExtractFields(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Set MyRegExp = New RegExp
MyRegExp.Multiline = True
MyRegExp.Global = True
MyRegExp.Pattern = """([^""]+)"",""([^""]+)"""
Set TextStream = FSO.OpenTextFile(FileName, ForReading, False, TristateFalse)
Text = TextStream.ReadAll
Set MyMatches = MyRegExp.Execute(Text)
For Each MyMatch in MyMatches
Field4 = SubMatches(0)
Field5 = SubMatches(1)
MsgBox "Field4: " & vbNewLine & Field4 & vbNewLine & vbNewLine _
& "Field5: " & vbNewLine & Field5, 0, "Found Match"
Next
Set MyMatches = Nothing
TextStream.Close()
Else
MsgBox "File " & FileName & " ... Not found"
End If
End Sub

Resources