FWIW I do something similar every day, though I run the macro from Outlook
when the mail arrives. The *Outlook* macro I use is as follows. Essentially
the macro grabs the most recent message in an Outlook mail folder called
Euro. It then opens a temporary Word document and inserts the content of the
message into it. It then calls a macro in Word which searches for a
particular string in the document containing the e-mail message and appends
it with the date to a table in a a second document in which the daily
information is stored. The document with the table is displayed for a short
time to allow it to be read and the date cell is formatted to emphasise
dates that are at the weekends before being saved and closed. The original
Word document is discarded.
You will need to modify the macros to your own application requirements.
Sub ExtractEuro()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim WordWasRunning As Boolean
Set olItems =
Application.Session.GetDefaultFolder(olFolderInbox).Folders("Euro").Items
' It is easier if you know the folder is sorted but this plays safe
olItems.Sort "[Received]", True
Set olItem = olItems(1)
WordWasRunning = True
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If wdApp.Version <> 12 Then Set wdApp = CreateObject("Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
WordWasRunning = False
End If
Set wdDoc = wdApp.Documents.Add
wdDoc.Content.InsertAfter olItem.Body
olItem.UnRead = False
Set olItem = Nothing
Set olItems = Nothing
'force Word to the foreground
wdApp.WindowState = wdWindowStateMinimize
wdApp.Visible = True
wdApp.WindowState = wdWindowStateNormal
' do whatever else you want here - Application.Run YourMacro etc.
wdApp.Run "ExtractEUR"
' and when you're finished
'If WordWasRunning = False Then
wdApp.Quit
'End If
Set wdDoc = Nothing
Set wdApp = Nothing
End Sub
The following is the Word macro that the Outlook macro calls
Sub ExtractEUR()
Dim strFound, strEuros, strGBP As String
Dim Check, Counter
Dim sfName As String, sFindText As String
sfName = "D:\My Documents\Test\Euro exchange data.docx"
sFindText = "GBP United Kingdom Pounds @1.[0-9]{10} @0.[0-9]{10}"
With Selection
.HomeKey Unit:=wdStory
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = sFindText
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute
End With
End With
strFound = Selection
On Error GoTo Oops:
Selection.Copy
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
strEuros = Mid(strFound, 43, 12)
strGBP = Right(strFound, 12)
Documents.Open FileName:=sfName
With Selection
.EndKey Unit:=wdStory
.MoveUp Unit:=wdLine, Count:=1
.MoveRight Unit:=wdCell, Count:=3
.InsertDateTime DateTimeFormat:="dd.MM.yyyy", _
InsertAsField:=False
.MoveRight Unit:=wdCell, Count:=1
.TypeText strEuros
.MoveRight Unit:=wdCell, Count:=1
.TypeText strGBP
End With
'If Weekday(Now) = vbMonday Then
Call FormatEuroDoc
'End If
Check = True: Counter = 0 ' Initialize variables.
Do ' Outer loop.
Do While Counter < 20000000 ' Inner loop.
Counter = Counter + 1 ' Increment Counter.
If Counter = 20000000 Then ' If condition is True.
Check = False ' Set value of flag to False.
Exit Do ' Exit inner loop.
End If
Loop
Loop Until Check = False ' Exit outer loop immediately.
ActiveDocument.Close SaveChanges:=wdSaveChanges
Exit Sub
Oops:
MsgBox "Copy text first!"
End Sub
--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Hello,
I was wondering if there is a way to use VB in Word to use it to
access my email account, find a particular email, and pull the
attchment, and have it pasted into an existing Word doc. Is this even
possible? The email I want it to get is something I recieve every
morning from the same sender. It always has a word document attached
from which I have to copy and paste it into another word document
that I have saved on my computer.
Any insight would be much appreciated. Thanks!
