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
Related
So I'm trying to make something that takes emails from a specific folder, and saves the attachments in a specific folder. I've taken this code from a previous post and retooled it for my purposes. It runs without error, but it isn't saving the file in the specified folder, and I can't for the life of me figure it out. Can anyone see my errors?
Sub ExtractFirstUnreadEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, Br As Object
Dim oOlAtch As Object
Dim eSender As String, dtRecvd As String, dtSent As String
Dim sSubj As String, sMsg As String
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)
Set Br = oOlInb.Folders("Brokers")
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")
eSender = oOlItm.SenderEmailAddress
dtRecvd = oOlItm.ReceivedTime
dtSent = oOlItm.CreationTime
sSubj = oOlItm.Subject
sMsg = oOlItm.Body
Exit For
Next
Const AttachmentPath As String = "C:\Desktop\Test"
'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & "-"
'NewFileName = oOlItm.Subject & Format(Date, "DD-MM-YYYY") & "-"
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In Br.Items
For Each oOlAtch In oOlItm.Attachments
Subject = "Test"
NewFileName = Subject
oOlAtch.SaveAsFile NewFileName & oOlAtch.Filename
Next
Exit For
Next
End Sub
I'd be so appreciative if anyone can point anything out. Thanks!
Picking a path at random is the road to failure.
The file should be saved in a folder named Test you created in C:\Desktop
Option Explicit
Sub ExtractFirstUnreadEmailDetails()
' Set up for Outlook
' not for other applications to use Outlook VBA code
Dim oOlInb As Folder
Dim Br As Folder
Dim oOlItm As Object
Dim oOlAtch As attachment
Dim Subject As String
'~~> Get Inbox of Outlook
Set oOlInb = Session.GetDefaultFolder(olFolderInbox)
Set Br = oOlInb.Folders("Brokers")
Const AttachmentPath As String = "C:\Desktop\Test"
'~~> New File Name for the attachment
Dim NewFileName As String
'~~> Extract the attachment from the 1st unread email
For Each oOlItm In Br.Items
For Each oOlAtch In oOlItm.Attachments
Subject = "Test"
' Note the often forgotten path separator
NewFileName = AttachmentPath & "\" & Subject & Format(Date, "DD-MM-YYYY") & "-" & oOlAtch.fileName
' C:\Desktop\Test\Test17-07-2018-fileName
Debug.Print NewFileName
oOlAtch.SaveAsFile NewFileName
Next
Exit For
Next
End Sub
The result should be a file named: Test17-07-2018-Filename in the folder C:\Desktop\Test
I try to coding is sending Rich text field via email , but I find an error that's I think this method for sending email, by following code
Sub Click(Source As Button)
Dim s As New NotesSession
Dim w As New NotesUIWorkspace
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim uidoc As NotesUIDocument
Set uidoc = w.CurrentDocument
Set s = New NotesSession
Set w = New NotesUIWorkspace
Set db = s.CurrentDatabase
Set doc = New NotesDocument (db)
doc.sendTo =s.UserName
doc.Subject = "Employee Information"
Dim rt As NotesRichTextItem
Set rt = New NotesRichTextItem ( doc, "Body" )
'Dim file As Variant 'if I use this code for declare for get value; Error : Type Mismatch
'Set file = doc.GetFirstItem("Body")
Dim rtitem As NotesRichTextItem 'if I use this code for declare for get value ; Error : Missing text object
Set rtitem = doc.GetFirstItem( "Body" )
Call rt.AppendRTItem(rtitem)
doc.Send(False)
End Sub
One thing I notice is that you don't set the form on the mail document you are creating.
You have some code you don't need, since you don't use uidoc anywhere, no need for that or declaring a NotesUIWorkspace object.
I also recommend that you use better variable names, and not to use extended notation when you set field values in a NotesDocument object.
I suggest that you take a look at the articles here:
http://blog.texasswede.com/how-to-write-better-code-in-notesdomino/
Below is the code that I cleaned up:
Option Public
Option Declare
Sub Click(Source As Button)
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim mailDoc As NotesDocument
Dim mailBody As NotesRichTextItem
Set db = session.CurrentDatabase
Set mailDoc = New NotesDocument(db)
Call mailDoc.ReplaceItemValue("Form","Memo")
Call mailDoc.ReplaceItemValue("SendTo",session.UserName)
Call mailDoc.ReplaceItemValue("Subject","Employee Information")
Set mailBody = New NotesRichTextItem(mailDoc,"Body" )
'Dim file As Variant 'if I use this code for declare for get value; Error : Type Mismatch
'Set file = doc.GetFirstItem("Body")
Dim rtitem As NotesRichTextItem 'if I use this code for declare for get value ; Error : Missing text object
Set rtitem = doc.GetFirstItem("Body")
Call mailBody.AppendRTItem(rtitem)
Call mailDoc.Send(False)
End Sub
The big question here is where you are getting the rich text field you want to send from? In your original code you are trying to read it from the newly created document (the one I call mailDoc). But that does not make any sense.
Your problem is simply that you are not reading the rich text from anywhere.
If your goal is to send an email, you can use my mail notification class:
http://blog.texasswede.com/updated-mailnotification-class-now-with-html-email-support-and-web-links/
Then your code would look something like this:
Dim session As New NotesSession
Dim mail As NotesMail
' *** Create a mail
Set mail = New NotesMail()
' Set receipient and subject
mail.MailTo = session.CommonUsername
mail.Subject = "Employee Information"
mail.Principal = "noreply#example.com"
' Create body content from rtitem.
' Yes, I should have added a method in the
' class to append RichtText to the mail body...
mail.body.AppendRTItem(rtitem)
Call mail.Send()
The only thing you have to do is to get the rtitem from somewhere. Since your original code declared a NotesUIWorkSpace object and a NotesUIDocument object, I am guessing you want to read it from the currently open document. Then you just add the following to the beginning of the code:
Dim ws As New NotesUIWorkspace
Dim thisdoc As NotesDocument
Dim rtitem as NotesRichTextItem
Set thisdoc = ws.CurrentDocument.Document
Set rtitem = thisdoc.GetFirstItem("Body")
Do you also see how much easier it is to read when you use descriptive variable names?
Hi you did not saved the document. Please be aware the Richtext is not available if the document is not saved.
I have a main form with a 'help' button which opens a simple form with a textbox that a user can use to submit issues noted with the main form. I would like the contents of what the user types into the textbox to be emailed to myself and a co-worker using a 'send' button.
I found the following code on stackoverflow which works except I can't figure out how to have the body of the email include what the user types into the textbox instead of the static text that's currently in the code.
Here's how the code looks now:
Private Sub SendEmail_Click()
Dim olApp As Object
Dim objMail As Object
Dim Issue As String
strIssue = Me.ContactMessageBox
On Error Resume Next 'Keep going if there is an error
Set olApp = GetObject(, "Outlook.Application") 'See if Outlook is open
If Err Then 'Outlook is not open
Set olApp = CreateObject("Outlook.Application") 'Create a new instance
End If
'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)
With objMail
.To = "emailaddress.com"
.Subject = "Form issue"
.Body = "strIssue"
.send
End With
MsgBox "Operation completed successfully"
End Sub
Does anyone have ideas about how to do this?
Change
Dim Issue As String
strIssue = Me.ContactMessageBox
...
.Body = "strIssue"
to
Dim strIssue As String
strIssue = Me.ContactMessageBox
...
.Body = strIssue
If you put your variable between "" then it is read as a string instead of the variable.
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
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>"