Outlook: copy & paste

[Andrzej]

Hello,

I am new in VBA.
Can you help me with the following problem:
I need to copy and paste msg files from c:\msg\*.msg to Outlook 2007 folder (for example “for_send”)
I did it by copy function (see code below) but unfortunately outlook can't see it as mailitem.
Outlook also changes an icon of message into unread message.
When I do copy and paste – it works.
When I use attached macro – also works, but as mentioned before Outlook “does” something with msg file.
Can you tell me how to realize function copy and paste to work as doing it “by hand”?
Maybe completely different way… but how?

Yours faithfully,
Andrzej


Sub copy()

Dim inPath As String
Dim thisFile As String
Dim olApp As Outlook.Application
Dim msgFile As Object

Set olApp = CreateObject("Outlook.Application")

inPath = "C:\msg\"
thisFile = Dir(inPath & "\*.msg")

Do While thisFile <> ""
Set msgFile = olApp.CopyFile(inPath + thisFile, "for_send")
thisFile = Dir
Loop

End Sub

 

[Michael Bauer]

See the Application.CreateItemFromTemplate function.

 

[Diane Poremsky]

This example shows how to open messages stored in the file system.
http://www.slipstick.com/developer/open-outlook-messages-stored-filesystem/

if you are doing this to send them, you might need to open the message and get the body and subject and create a new message.
Set newMsg = Application.CreateItem(olMailItem)
newMsg.subject = msgFile.subject
newMsg.body = msgFile.body
newMsg.to = "address@domain.com"
newMsg.display ' .send to send

 

[Andrzej]

Thank you very much Diane,
I adapted macro from link, it works, but ... after copying msg files into Outlook folder message remains open for edition - I can't change this.
I would like to have the same effect as doing copy& paste.

Is there maybe another method to copy files from hard drive (msg) into Outlook folder as mailitem ?

 

[Diane Poremsky]

ok... was able to make it work by opening the messages then copying -

Top of module:
Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


After you get the file path:

ShellExecute 0, "open", FileItem.Path, vbNullString, vbNullString, 0

' need the timer so the message has time to open
Dim time1, time2
time1 = Now
time2 = Now + TimeValue("0:00:01")
Do Until time1 >= time2
DoEvents
time1 = Now()
Loop

Set openMsg = Application.ActiveInspector.CurrentItem

openMsg.Display

'saves to inbox
openMsg.Copy

openMsg.Close olDiscard

 

[Diane Poremsky]

ok - here is a better, faster version - it checks for msg files in the sourcefolder and copies them to outlook - you can hard-code the path or use the current folder.

Sub ImportMessagesInFolder()
    Dim FSO As Scripting.FileSystemObject
    Dim SourceFolder As Scripting.Folder
    Dim SourceFolderName As String
    Dim FileItem As Scripting.File
    Dim strFile, strFileType As String
    Dim openMsg As Object
    Dim copiedMsg As MailItem
    Dim Savefolder As Outlook.Folder
   
    Set FSO = New Scripting.FileSystemObject
    SourceFolderName = "C:\Users\drcp\Documents\Attachments\"
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
   
   'Set the Outlook folder - use specific or use current folder
    'Set Savefolder = Session.GetDefaultFolder(olFolderInbox).Folders("Saved")
   Set Savefolder = Application.ActiveExplorer.CurrentFolder
   
    For Each FileItem In SourceFolder.Files
      strFile = FileItem.Name
      
' This code looks at the last 4 characters in a filename
    strFileType = LCase$(Right$(strFile, 4))
    If strFileType = ".msg" Then
    
    Set openMsg = Session.OpenSharedItem(FileItem.Path)
        On Error Resume Next
    Set copiedMsg = openMsg.Copy
        copiedMsg.Move Savefolder

    Set copiedMsg = Nothing
    openMsg.Close olDiscard
    Set openMsg = Nothing
    End If
     
    Next FileItem

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
     
End Sub

 

[Andrzej]

Diane,
You are genius !
THANK YOU VERY MUCH!

Andrzej

 

[Andrzej]

Dear Diane,
Can you help me once again?
I've noticed that after sub is finished the copied e-mail remains in Inbox folder.
I have them doubled : in Inbox and in Savefolder.
I've checked it on Outlook 2010 and Outlook 2013.
Shall I wrote a piece of code which removes e-mails from Inbox or is there another solution?

Andrzej

 

[Diane Poremsky]

After you copy to the inbox, you should be able to delete the original from the hard drive after closing it
openMsg.Close olDiscard
openMsg.Delete

If not try this -

openMsg.Close olDiscard
fso.DeleteFile openMsg

Accessing Files with FileSystemObject

 

[Andrzej]

Thank you very much !
It works.
I really appreciate your help.

Andrzej