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 olImprotanceLow

Apart from the spelling of the alternatives, the line should read

.Importance = 1 'Or 2 Or 0

if 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 olImprotanceLow

Apart from the spelling of the alternatives, the line should read

.Importance = 1 'Or 2 Or 0

if 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.