VBA Macro - Word

[MartinEbner]

Hi,

Issue
I have modified a macro (please see below) - it encompasses all of the functionality that I require with one exception. I require it to reference an email address that is written in the word document.

Macro
Sub eMailActiveDocument()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document

Application.ScreenUpdating = True
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "Subject"
.Body = "Dear Whoever,
.To = "User.Domain.Com"
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.Fullname
.Display
End With

Application.ScreenUpdating = True

Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing

End Sub

-----------

Instead of it having a prescribed email in the macro, I need it to be flexible in the sense that from time to time the email address will change and as such it is impractical go into the macro every time - It needs to source it from the word document itself.

Any help would be greatly appreciated.

Regards,
Martin

[gmaxey]

lets say it is written in a document content control titled "Email Address"

.To = Doc.SelectContentControlsByTitle("Email Address").Item(1).Range.Text '

[gmayor]

.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLowApart from the spelling of the alternatives, the line should read

.Importance = 1 'Or 2 Or 0if you want to use late binding to Outlook. Similarly olMailItem should be '2'.

As for the e-mail address, without some point of reference for where to look for the address in the document it is not possible to come up with a foolproof way of identifying the e-mail address. The code below will locate the first e-mail address in the body of the document. If that is not appropriate, tell us more about how the document is laid out, where the e-mail address is located and whether there are likley to be other e-mail addresses anywhere in the document that may cause confusion.
If you use
.Body = .Body = "Dear Whoever,"then note that this will take out your automatic signature. If you want to write to the body use the document inspector

Option Explicit
Sub eMailActiveDocument()
Dim OL As Object
Dim olInsp As Object
Dim EmailItem As Object
Dim Doc As Document
Dim wdDoc As Document
Dim oRng As Range, oFind As Range
Dim bFound As Boolean
Dim strTo As String
Const strFind As String = "[a-zA-Z0-9\-_.]{1,}\@[a-zA-Z0-9\-_.]{1,}"

Set Doc = ActiveDocument
Doc.Save
If Doc.Path = "" Then GoTo lbl_Exit
Set oFind = Doc.Range
strTo = ""
With oFind.Find
Do While .Execute(FindText:=strFind, MatchWildcards:=True)
strTo = oFind.Text
bFound = True
Exit Do
Loop
End With
If Not bFound Then
MsgBox "Email address not found!"
'Goto lbl_exit 'Optional quit
End If
On Error Resume Next
'Get Outlook if it's running
Set OL = GetObject(, "Outlook.Application")
'Outlook wasn't running, start it from code
If Err <> 0 Then
Set OL = CreateObject("Outlook.Application")
End If
On Error GoTo err_Handler
Set EmailItem = OL.CreateItem(0)
With EmailItem
.to = strTo
.Subject = "Subject"
.Importance = 1
.Attachments.Add Doc.FullName
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.Text = "Dear Whoever,"
.Display
End With
lbl_Exit:
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Set wdDoc = Nothing
Set olInsp = Nothing
Set oRng = Nothing
Set oFind = Nothing
Exit Sub
err_Handler:
MsgBox Err.Number & vbCr & Err.Description
Err.Clear
GoTo lbl_Exit
End Sub

[MartinEbner]

.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLowApart from the spelling of the alternatives, the line should read

.Importance = 1 'Or 2 Or 0if you want to use late binding to Outlook. Similarly olMailItem should be '2'.

As for the e-mail address, without some point of reference for where to look for the address in the document it is not possible to come up with a foolproof way of identifying the e-mail address. The code below will locate the first e-mail address in the body of the document. If that is not appropriate, tell us more about how the document is laid out, where the e-mail address is located and whether there are likley to be other e-mail addresses anywhere in the document that may cause confusion.
If you use
.Body = .Body = "Dear Whoever,"then note that this will take out your automatic signature. If you want to write to the body use the document inspector

Option Explicit
Sub eMailActiveDocument()
Dim OL As Object
Dim olInsp As Object
Dim EmailItem As Object
Dim Doc As Document
Dim wdDoc As Document
Dim oRng As Range, oFind As Range
Dim bFound As Boolean
Dim strTo As String
Const strFind As String = "[a-zA-Z0-9\-_.]{1,}\[a-zA-Z0-9\-_.]{1,}"

Set Doc = ActiveDocument
Doc.Save
If Doc.Path = "" Then GoTo lbl_Exit
Set oFind = Doc.Range
strTo = ""
With oFind.Find
Do While .Execute(FindText:=strFind, MatchWildcards:=True)
strTo = oFind.Text
bFound = True
Exit Do
Loop
End With
If Not bFound Then
MsgBox "Email address not found!"
'Goto lbl_exit 'Optional quit
End If
On Error Resume Next
'Get Outlook if it's running
Set OL = GetObject(, "Outlook.Application")
'Outlook wasn't running, start it from code
If Err <> 0 Then
Set OL = CreateObject("Outlook.Application")
End If
On Error GoTo err_Handler
Set EmailItem = OL.CreateItem(0)
With EmailItem
.to = strTo
.Subject = "Subject"
.Importance = 1
.Attachments.Add Doc.FullName
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.Text = "Dear Whoever,"
.Display
End With
lbl_Exit:
Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing
Set wdDoc = Nothing
Set olInsp = Nothing
Set oRng = Nothing
Set oFind = Nothing
Exit Sub
err_Handler:
MsgBox Err.Number & vbCr & Err.Description
Err.Clear
GoTo lbl_Exit
End Sub


Hi,

Thank you for such a detailed response. Unfortunately, I am presented with the error '91 Object Variable or With Variable block not set'.

Any thoughts?

Thanks,

[MartinEbner]

lets say it is written in a document content control titled "Email Address"

.To = Doc.SelectContentControlsByTitle("Email Address").Item(1).Range.Text '

Hi gmaxey,

It is not written into the document as a content control, it is a mail merge object.

I have attempted to use this code but it does not identify the email address.

Kind Regards,
Martin

[gmayor]

Do you still get the error if Outlook is already running? In some circumstances the relationship between Word and Outlook can be unreliable. It should be OK if you start Outlook first. You could also change On Error GoTo err_Handler to On Error GoTo 0 and see which line is highlighted when it fails - or remove the line altogether.

As this document appears to relate to mail merge, you could take advantage of http://www.gmayor.com/ManyToOne.htm which in one to one mode will merge your document as an attachment, with an additional personalised covering message if you wish. The data source must be Excel for this to work.

[MartinEbner]

Do you still get the error if Outlook is already running? In some circumstances the relationship between Word and Outlook can be unreliable. It should be OK if you start Outlook first. You could also change On Error GoTo err_Handler to On Error GoTo 0 and see which line is highlighted when it fails - or remove the line altogether.

As this document appears to relate to mail merge, you could take advantage of which in one to one mode will merge your document as an attachment, with an additional personalised covering message if you wish. The data source must be Excel for this to work.

Hi gmayor,

I had a full head of hair before I began working on this project!!! haha.

Unfortunately, it is not working and I am sceptical if it will work due to my limited proficiency in VB. However, this said, is there any way in which I can order MS Word to 'PRINT' before saving attachment. The script below is fully functional to my requirements with caveat that I would like it to attach as PDF rather than .docm as my clients' PC may reject it due to it having code.


Sub eMailActiveDocument()
Dim OL As Object
Dim EmailItem As Object
Dim Doc As Document

Application.ScreenUpdating = True
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Doc = ActiveDocument
Doc.Save
With EmailItem
.Subject = "Title"
.Body = "Dear Client,"
.To = ""
.Importance = olImportanceNormal 'Or olImprotanceHigh Or olImprotanceLow
.Attachments.Add Doc.Fullname
.Display
End With

Application.ScreenUpdating = True

Set Doc = Nothing
Set OL = Nothing
Set EmailItem = Nothing

End Sub


PDF Driver = Bullzip

I wholly appreciate your support with this - it has been a steep learning curve!

Best Wishes,
Martin

[gmayor]

Yes you can print to PDF or save as PDF then attach the named PDF, but not until you figure out what you have done wrong that makes the code not work. That code must be alone in the module. The Many to One add-in will create PDF attachments during the merge and requires no VBA experience.