I am looking for a VB Script that will "phone home" if the document is open. I have created an empty macro named AutoOpen which executes properly when the document is open.
I would like to collect the time, current user logged in, and computer name and then automatically send an email address with that information. Basically to see who is opening that document.
Is there a way to do that with VB in word?
I haven't seen any php like function calls that send an email out for example mail("blahblah#mail.com", "mysubject", "my text"); That is kind of what I am looking for but in VB
Here is my email code that I use ALL the time.
Sub EmailCopy()
Dim oApp, oMail As Object
On Error Resume Next
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = "Someone#Somewhere.com.au"
.Subject = "My Subject Title"
.Body = "Here is the information you asked for"
.Send
End With
Set oMail = Nothing
Set oApp = Nothing
End Sub
Try to implement it into your code and post back if you get stuck. You will need a reference to outlook (I am assuming you are sending via outlook? if not you need to use the CDO method posted by Mat's Mug)
Also maybe remove the vbscript tag from your question, this is VBA :)
Related
We currently have an email automatically created by Excel using VBA, with subject, recipient, message body with template text all filled in.
Sub CreateMail(Optional sFile As String = "")
'Create email to send to requestor with attachment sFile
'Declarations
Dim app As Outlook.Application
Dim msg As Outlook.MailItem
Dim send_to As Recipient
Dim send_tos As Recipients
'Initiations
Set app = CreateObject("Outlook.Application")
Set msg = app.CreateItem(olMailItem)
Set send_tos = msg.Recipients
Set send_to = send_tos.Add("receiver#email.com")
send_to.Type = 1
'Create message
With msg
.SentOnBehalfOfName = "sender#email.com"
.Subject = "This is the email subject"
.HTMLBody = "This is the email body" & vbCrLf
'Resolve each Recipient's name.
For Each send_to In msg.Recipients
send_to.Resolve
Next
If Len(sFile) > 0 Then
.Attachments.Add sFile
End If
.Display
End With
End sub
After making some manual changes to the email that is created, we'd like to send it and have a copy saved to a folder on the file system automatically (in addition to the usual sent folder in Outlook). Is there a way to do this all within Excel VBA?
I suspect it might be possible using Outlook VBA, however the folders are defined in Excel and we'd like to keep the code together in the one file.
What is your code for sending email? This works for me in an Excel VBA module:
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
.BodyFormat = olFormatRichText
.To = "email address"
.Subject = "Test"
.HTMLBody = "Test " & Now
.DeleteAfterSubmit = True 'to not retain in sent folder
.Display
.SaveAs "C:\filepath\Test.txt", 0
' .Send
End With
However, guess the real trick is allowing edit of the email before saving file. So far not seeing solution for that. Unfortunately the code execution does not pause while the message window is open. I was hoping for the pause since Office is supposed to be an integrated suite of apps - like opening a form in Access in dialog mode which does pause execution of code.
With code in Excel only, monitor the SentItems folder.
Utilizing Outlook Events From Excel
Confirm the mail from a unique ID.
The unique ID could be in the subject or body.
You could try saving the unique ID in PR_SEARCH_KEY. It is the same idea How, can get the exact sent Email from Sent Items folder? and How to uniquely identify an Outlook email as MailItem.EntryID changes when email is moved
I am currently in the process of anonymizing emails with vba for a project.
Currently when an email is received I have created a rule which moves the email into a folder, thereafter I run a script using the getlast function, in that specific folder, where I display the newly received email and copy the content of the email and then i paste this into a new email and send to a particular email address. This effectively removes the identifying features of the email.
The final movement to the Rubik's Cube is to find the email signature and replace with blank, in other words delete the signature. I will have the email signatures to do this, however it would be great if someone someone could help with this...
I found this solution.
'I also had to add Word in tools/references of VBA and then Call DeleteSig(msg) after displaying the item.
'http://www.access-programmers.co.uk/forums/showthread.php?t=259417
Sub DeleteSig(msg As Outlook.MailItem)
Dim objDoc As Word.Document
Dim objBkm As Word.Bookmark
On Error Resume Next
Set objDoc = msg.GetInspector.WordEditor
Set objBkm = objDoc.Bookmarks("_MailAutoSig")
If Not objBkm Is Nothing Then
objBkm.Select
objDoc.Windows(1).Selection.Delete
End If
Set objDoc = Nothing
Set objBkm = Nothing
End Sub
It's not very hard, but depend on some properties of the mail:
Is the mail plain text? or html
if HTML, do you have the signature in html format ? (with tags)
I presume you read your mail with a variable of type Outlook.MailItem
' Definition of your mail
Dim OutMail As Outlook.MailItem
dim signature as string
...
with OutMail
.HTMLBody = Replace(.HTMLBody, signature, "")
End with
If the signature you have is not the exact match, it'll be a little more tricky.
I suggest to create a function that detect the signature and return the HTMLBody without it
I am trying to get this code to work.
I want to select multiple emails from my inbox and send a auto reply using a template.
I am getting a run-time error: Object variable or With Block variable not set.
Any help would be appreciated. Also I would like to add a msg box telling me how many items were sent.
Option Explicit
Sub ReplywithTemplate()
Dim Item As Outlook.MailItem
Dim oRespond As Outlook.MailItem
For Each Item In ActiveExplorer.Selection
' This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("C:\Users\Accounting\AppData\Roaming\Microsoft\Templates\scautoreply.oft")
With oRespond
.Recipients.Add Item.SenderEmailAddress
.Subject = Item.Subject
' includes the original message as an attachment
.Attachments.Add Item
' use this for testing, change to .send once you have it working as desired
.Display
End With
On Error Resume Next
Next
Set oRespond = Nothing
End Sub
I have noticed the following lines of code:
For Each oRespond In ActiveExplorer.Selection
' This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("C:\Users\Accounting\AppData\Roaming\Microsoft\Templates\scautoreply.oft")
With oRespond
You need to use a new variable for creating an auto-reply email from a template because the selected Outlook item is missed (replaced with a newly created one).
So, basically you can create an item from a template, add recipients from the selected Outlook item and call the Send method. Or you can use the Reply method of the selected item in Outlook, copy the required properties from a template and call the Send method. It is up to you which way is to choose.
Finally, you may find the Getting Started with VBA in Outlook 2010 article helpful.
I found the below code from a very helpful post by user thommck. It forwards selected items as attachments in separate emails to a specified recipient.
When I use the code, the forward symbol does not appear on the email icon of the email I just forwarded. If I use the regular Outlook method for "Forward as Attachment," the symbol is added to the envelope icon in my viewing pane.
Any ideas on how to get this forward symbol to appear when using this code?
Sub ForwardSelectedItems()
On Error Resume Next
Dim objItem As Outlook.MailItem
If Application.ActiveExplorer.Selection.Count = 0 Then
MsgBox ("No item selected")
Exit Sub
End If
For Each objItem In Application.ActiveExplorer.Selection
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.Attachments.Add objItem, olEmbeddeditem
.Subject = "enter text"
.To = "example#example.com"
.Send
End With
Next
Set objItem = Nothing
Set objMsg = Nothing
End Sub
You need to use the Forward method of the MailItem class instead of creating a new mail item in the code:
Application.CreateItem(olMailItem)
should be replaced with:
objItem.Foward()
Note, you need to clear the message body if you don't want to see the content of the attached item.
You may find the Getting Started with VBA in Outlook 2010 article helpful.
You can simulate pressing a button with ExecuteMso.
https://msdn.microsoft.com/en-us/library/office/ff862419%28v=office.15%29.aspx
expression.ExecuteMso(idMso)
expression An expression that returns a CommandBars object.
To find the idMso, go through the process of adding a button to the Quick Access Toolbar or a ribbon. Once you find the control in the list, hover over it until the tooltip appears. The idMso is the name in brackets.
In this case it is ForwardAsAttachment
What I am trying to get done is to have it so that on a few E-Mail templates we have at my job, when we drag and drop a certain Excel file to it, it will select and copy a range of that Excel file into the body of the email. My only question, as I've looked everywhere and all the code I've found seems to be for emails that are being received, not written, is how do I access:
The attachments in an email that I am writing
The body of the E-Mail I am writing
I'm sure I can get the code for everything else I want once I can get the attachments for the current Email.
Before any mentions "just record the macro and see how outlook does it" for some reason my outlook does not have a "record macro" item anywhere, as that was my first go-to as well.
how do I access: The attachments in an email that I am writing The
body of the E-Mail I am writing
Here is a very basic example. I have not done any error handling but I am sure you can take care of it.
Let's say the email that you are writing looks like this
All you need is this code
Sub Sample()
Dim NewMail As MailItem, oInspector As Inspector
Set oInspector = Application.ActiveInspector
'~~> Get the current open item
Set NewMail = oInspector.CurrentItem
With NewMail
Debug.Print .To
Debug.Print .subject
Debug.Print .Body
AttchCount = .Attachments.Count
If AttchCount > 0 Then
For I = 1 To AttchCount
'~~> Print Attachment names
Debug.Print .Attachments.Item(I).DisplayName
Next I
End If
End With
End Sub
Output