CDOSYS and Unicode in the from field - email

I've got the code below, and I'm trying to set the from field to allow Unicode. Currently in my email client I get "??".
The subject line and any content shows the Unicode correctly. And looking at the MSDN, the property should be "urn:schemas:httpmail:from".
Anyone solved this issue?
Dim AC_EMAIL : AC_EMAIL = "test#test.com"
Dim AC_EMAIL_FROM : AC_EMAIL_FROM = "测试 <test#test.com>"
Dim strSubject : strSubject = """测试"" testing testing"
set oMessage = WScript.CreateObject("CDO.Message")
With oMessage
.BodyPart.charset = "utf-8" 'unicode-1-1-utf-8
.Fields("urn:schemas:httpmail:from") = AC_EMAIL_FROM
.Fields("urn:schemas:httpmail:to") = AC_EMAIL
.Fields("urn:schemas:httpmail:subject") = strSubject
.Fields.Update
.Send
End With
Set oMessage = Nothing

Found a work around. Not the prettiest, but it works. Basically I converted the string to Quoted-Printable.
.Fields("urn:schemas:httpmail:from") = "=?utf-8?Q?=E6=8F?= <test#test.com>"

Related

Outlook email script read UTF8 file

On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
Set WshShell = CreateObject("WScript.Shell")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strTitle = objUser.Description
strCred = objUser.Info
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
strFailas1 = "1.jpg"
strFailas2 = "2.jpg"
strFailas3 = "3.jpg"
strFailas4 = "4.jpg"
strSPath1 = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERPROFILE%") & "\Appdata\Roaming\Microsoft\Signatures\" & strFailas1
strSPath2 = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERPROFILE%") & "\Appdata\Roaming\Microsoft\Signatures\" & strFailas2
strSPath3 = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERPROFILE%") & "\Appdata\Roaming\Microsoft\Signatures\" & strFailas3
strSPath4 = CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERPROFILE%") & "\Appdata\Roaming\Microsoft\Signatures\" & strFailas4
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
If (strCred) Then objSelection.TypeText strName & ", " & strCred Else objSelection.TypeText strName
objSelection.TypeParagraph()
Set adoStream = CreateObject("ADODB.Stream")
adoStream.Open
adoStream.Charset = "UTF-8"
adoStream.LoadFromFile "file.txt"
BodyTEXT = adoStream.ReadText(-1)
adoStream.TypeText BodyTEXT
adoStream.Close
Set adoStream = Nothing
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Full Signature", objSelection
objSignatureObject.NewMessageSignature = "Full Signature"
objDoc.Saved = True
objWord.Quit
I'm trying to create a VBScript to automatically genarate email signature for all users in Active Directory, but I have a problem. I want to insert UTF8 *.txt file as email signature body but it's not displayed after I run this script. Maybe I need to set it as different variable or something?
VBScript troubleshooting 101: remove On Error Resume Next, so you can actually see what goes wrong. Contrary to popular belief the statement doesn't magically make errors disappear. It just prevents the interpreter from telling you about them.
Never ever use globel On Error Resume Next in production code.
*steps off soap box*
With that said, you read the text into the variable BodyTEXT, which works just fine. However, you then try to call adoStream.TypeText with it. Without the global On Error Resume Next that statement would have raised an error
Object doesn't support this property or method.
because ADODB.Stream objects don't have such a method.
You probably intended to write objSelection.TypeText BodyTEXT instead.

Parse a responseText to HTML in VBScript

I'm trying to retrieve HTML Class Names from a string variable created by responseText. I need to accomplish this using VBscript. Here is a sample of current code:
set http = createobject("Microsoft.XmlHttp")
http.open "GET","http://www.xxxxxxxxxxx.com/xxx-xxx?xxxxNumber=xxxxx",false
http.send ""
dim html : set html = CreateObject("HTMLFILE")
html.write http.responseText
dim trackdate : trackdate = html.getElementByClassName("tracking-history-date").[0].value
wscript.echo trackdate
I'm receiving the following error: Object doesn't support this property or mehtod: 'getElementByClassName'
I've run into this before. Although documented, the getElementsByClassName() method doesn't seem to actually be supported. Use something like this to work around the issue:
For Each el In html.getElementsByTagName("...")
If el.ClassName = "tracking-history-date" Then
Set trackdate = el
Exit For
End If
Next

sending outlook based email in VBScript - error (sfile as string) line?

im trying to send an email from a VBScript, it will eventually be added into a currently working script as an else if (if this is possible).
im getting an error at line 23 character 32?
Dim outobj, mailobj
Dim strFileText
Dim objFileToRead
Set outobj = CreateObject("Outlook.Application")
Set mailobj = outobj.CreateItem(0)
strFileText = GetText("C:\test\test 2.txt")
With mailobj
.To = "user#user.com"
.Subject = "Testmail"
.Body = strFileText
.Display
End With
Set outobj = Nothing
Set mailobj = Nothing
End Sub
Function GetText(sFile as String) As String
Dim nSourceFile As Integer, sText As String
nSourceFile = FreeFile
Open sFile For Input As #nSourceFile
sText = Input$(LOF(1), 1)
Close
GetText = sText
End Function
what do i need to add to get line 23 to work and the script to finally do what i need it to, i have copied most of this script from elsewhere due to a sincere lack of VBscripting knowledge?
Take a look at the Using Automation to Send a Microsoft Outlook Message article. It provides a sample code and describes all the required steps for sending emails.
Try this: remove the GetText function entirely, and replace the line
strFileText = GetText("C:\test\test 2.txt")
with
Set fso = CreateObject("Scripting.FileSystemObject")
strFileText = fso.OpenTextFile("C:\test\test 2.txt").ReadAll

Excel VBA URL hyperlink in RichText email body

Does anyone know how to create a RichText email body, that has a URL bookmark in it?
For example, here is my code:
Sub SendEmailUsingWord()
Dim olApp As Outlook.Application
Dim olEmail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Word.Document
Dim strBody As String
' The body of the message, want to create a hyperlink to (e.g.) http://www.google.com but
' still display HERE.
' In HTML it would be HERE
' But I want to achieve this in a Rich Text email
strBody = "Please click HERE to be fantastic!" & vbNewLine
Set olApp = New Outlook.Application
Set olEmail = olApp.CreateItem(olMailItem)
With olEmail
.BodyFormat = olFormatRichText
.Display
.To = "someone#someone.com"
.Subject = "Email Subject"
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
wdDoc.Range.InsertBefore strBody
'.send
End With
End Sub
Many thanks for your help :)
Dave
After Dmitry pointing me in the right direction, I tried the following code:
wdDoc.Hyperlinks.Add wdDoc.Range, "http://www.google.com", , , "HERE"
and it has solved my problem!
I wasn't considering the word.document object when creating the email body, when I should have been. Hope this helps someone else.
There's small change in your code.
You need to add BODYFORMAT as
.BodyFormat = olFormatHTML
After setting BODYFORMAT, set the HTMLBODY of the Email.
.HTMLBody = "<HTML><H2>The body of this message will appear in HTML.</H2><BODY>Type the message text here. </BODY></HTML>"
Check this link for complete example:
http://msdn.microsoft.com/en-us/library/office/ff869979(v=office.15).aspx

CDOSys having issue with multiple attachments

I have been using CDOSys object for email sending in Classic ASP and it's work well with single file attachment but does not work correctly for multiple attachments.It takes the name and file extension of last attachment file for all attachments.Please let me know where is the issue.Below is my code
Function Send_Email_WithAttachments(strFrom,strTo,strSubject,strBody,strCC,strBCC,arrFiles,arrText)
Dim mailObj,I
Set mailObj=CreateObject("CDO.Message")
With mailObj
.Subject=strSubject
.From=strFrom
.To=strTo
If isValidEmail(strCC) = True Then
.CC = strCC
End If
If isValidEmail(strBCC) = True Then
.BCc = strBCC
End If
.HTMLBody = strBody
If IsArray(arrFiles) = True Then
For I=0 To UBound(arrFiles)
.AddAttachment arrFiles(I)
With mailObj.Attachments(1).Fields
.Item(cdoContentDisposition) = "attachment;filename="&arrText(I)
.Update
End With
Next
End If
.Send
End With
Set mailObj=Nothing
End Function
Thanks, Ravi
You address the same attachement (index==1) within the loop here:
With mailObj.Attachments(1).Fields
it should be;
With mailObj.Attachments(I).Fields