paste to text box

[DMT Dave]

Hi Guy's, I am trying to copy an active email body to a word document and paste from word doc to a text box called txtDocMessage



I have managed to achieve copying the email body, open word and adds the body perfect, how can I copy the word doc to text box ?

Much appreciated as always

Dim WordApp As Word.Application
Dim wdDoc As Word.Document
Dim activeMailMessage As MailItem
If TypeName(ActiveExplorer.Selection.Item(1)) = "MailItem" Then
    'Get a handle on the email
    Set activeMailMessage = ActiveExplorer.Selection.Item(1)
    'Ensure Word Application is open
    Set WordApp = CreateObject("Word.Application")
    'Make Word Application visible
    WordApp.Visible = True
    'Create a new Document and get a handle on it
    Set wdDoc = WordApp.Documents.Add
    'Copy the formatted text:
    activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
    'Paste to the word document
    wdDoc.Range.Paste
    'Clear the clipboard entirely:
    ' Call ClearClipBoard
End If

[June7]

What do you mean by 'paste the word doc'? You want all text in Word document selected and copy/paste to a textbox in Access?

[DMT Dave]

Hi June7 is exactly what i am looking for, i will probably add new record to save the contents additional to question but if it is pasted to a text box, i can save for that, in fact better i do it that way as i can check contents before saving

[Minty]

Am I missing something, why not simply copy the email directly to the text box ?
Is it available in a local outlook session?

[DMT Dave]

Hi minty, yes that would be great, would you be able to send an example in vba ?

Much appreciated

[Minty]

It's not something I have done personally, however a quick google brought this up;
https://stackoverflow.com/questions/...46315#12146315 for excel, but should give you some ideas.

And I'm sure I've seen other examples, both here and on some other forums.

[DMT Dave]

Hi minty, all you guy's out there are fab

I have played and this very simple code does the trick

Dim activeMailMessage As MailItem

If TypeName(ActiveExplorer.Selection.Item(1)) = "MailItem" Then


    Set activeMailMessage = ActiveExplorer.Selection.Item(1)
    
    Me.txtMailBody = activeMailMessage


End If

[Minty]

Excellent - much simpler solution.

[DMT Dave]

Ahh just copies the subject and not the mail body, yet when added to a word doc, it copies and pastes the body ??

Any ideas ?

[June7]

This works for me.

Public Sub ImportEmails()
' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim of As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim mo As Outlook.MailItem, Atmt As Outlook.Attachment
'Set of = ol.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox).Folders("Repairs")
Set of = ol.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
Set objItems = of.Items
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tblEmails")
For Each mo In objItems
    rst.AddNew
    rst!Sender = mo.SenderEmailAddress
    rst!SenderName = mo.Sender
    rst!Subject = mo.Subject
    rst!body = mo.body
    rst!Received = mo.ReceivedTime
    rst.Update
    'For Each Atmt In mo.Attachments
    '    Atmt.SaveAsFile "C:\Users\June\Forums\" & Atmt.FileName
    'Next
Next
End Sub

Or for only selected emails in Outlook.

Sub GetEmailBody()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objSelection As Outlook.Selection
Dim strFolderPath As String
' Get the path to your My Documents folder
strFolderPath = CreateObject("WScript.Shell").SpecialFolders(16)
On Error Resume Next
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
For Each objMsg In objSelection
    Debug.Print objMsg.body
Next
End Sub

And look at this one. Should be able to include WHERE clause in the SQL.

Sub InboxImport()
    Dim SqlString As String
    Dim ConnectionString As String
    Dim EmailTableName As String
    Dim UserIdNum As String
    Dim EmailAddr As String
    Dim ol As Outlook.Application
    Dim olNS As Outlook.NameSpace
    Dim olFol As Outlook.folder
    'Dim rs As DAO.Recordset    Set ol = CreateObject("Outlook.Application")
    Set olNS = ol.GetNamespace("MAPI")
    Set olFol = olNS.GetDefaultFolder(olFolderInbox)
    EmailTableName = "MyInbox"
    UserIdNum = Environ("USERNAME")  '1277523A...
    EmailAddr = olFol.Parent.Name 'Gives your user email address
    ConnectionString = "Outlook 9.0;MAPILEVEL=" & EmailAddr & "|;PROFILE=Default Outlook Profile;TABLETYPE=0;TABLENAME=MyInbox;COLSETVERSION=12.0;DATABASE=C:\Users\" & UserIdNum & "\AppData\Local\Temp\"
    'SqlString = "SELECT [From] As [Sender], [Sender Name] As [SenderName], [Subject Prefix] & [Normalized Subject] As Subject, [Contents] As [Body], [Received] As [ReceivedTime]" & _
            " INTO [MyInbox]" & _
             " From [" & ConnectionString & "].[Inbox]"
    SqlString = "INSERT INTO MyInbox SELECT [From] As [Sender], [Sender Name] As [SenderName], [Subject Prefix] & [Normalized Subject] As Subject, [Contents] As [Body], [Received] As [ReceivedTime]" & _
             " FROM [" & ConnectionString & "].[Inbox]"
    'CurrentDb.Execute SqlString
    Debug.Print SqlString
End Sub