Repost:Outlook Code move attachment 1

[romnew]

The following code was suggested by fumei who assisted greatly.But there is a slight hitch.
pleaHi Gerry,
I have adapted your code slightly(you will notice where) but it comes uo with an error type mismatch at the line, marked****.
Any ideas why?
Thanks again for helping
Piet

The code:
Dim olApp As Outlook.Application
Dim objNameSpace As NameSpace
Dim objInbox As MAPIFolder
Dim objMail As MailItem
Dim objAttach As Attachment

Set olApp = CreateObject("Outlook.Application")
Set objNameSpace = olApp.GetNamespace("MAPI")
Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox)
For Each objMail In objInbox.Items()
If objMail.UnRead = True Then
Set objAttach = objMail.Attachments ****

objAttach.SaveAsFile "C:\Rossair3\" & _
objAttach.item(1).DisplayName

End If
Next
Set objInbox = Nothing
Set objNameSpace = Nothing
Set olApp = Nothingse help

 

[PHV]

Dim objAttach As Attachment
vs
Set objAttach = objMail.Attachments
Not same objects, so type mismatch.
Try to replace this:
Set objAttach = objMail.Attachments
objAttach.SaveAsFile "C:\Rossair3\" & _
objAttach.item(1).DisplayName
By this:
For Each objAttach In objMail.Attachments
objAttach.SaveAsFile "C:\Rossair3\" & _
objAttach.item(1).DisplayName
Next

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[fumei]

Thanks PHV.

Gerry

 

[romnew]

Thanks PHV and Gerry.
I will test new code and publish the new workable
code.
Thanks you guys!
Piet

 

[romnew]

Hi PHV,
Please bear with me. This is the first attempt to do something with outlook programming, and what a battle.
The code below as suggested boms out with: "cannot save attachments. You dont have adequate permissions" I have checked OUTLOOK for a setting but no luck.
Dim olApp As Outlook.Application
Dim objNameSpace As NameSpace
Dim objInbox As MAPIFolder
Dim objMail As MailItem
Dim objAttach As Attachment

Set olApp = CreateObject("Outlook.Application")
Set objNameSpace = olApp.GetNamespace("MAPI")
Set objInbox = objNameSpace.GetDefaultFolder(olFolderInbox)
For Each objMail In objInbox.Items()
If objMail.UnRead = True Then
For Each objAttach In objMail.Attachments
objAttach.SaveAsFile ("C:\Rossair3")

Next


End If
Next
Set objInbox = Nothing
Set objNameSpace = Nothing
Set olApp = Nothing
By the way the code was not happy with save display, it was rejected saying does not support action.
Piet

 

[fumei]

I have to check on saving files in Outlook again. I am at home now, and I sure as heck do not use Outlook. Use it at work, so it will have to wait. But I think the syntax for saving the file is wrong. Something is missing, but I can't remember what.

Do you have write permissions on that folder?

Gerry

 

[PHV]

Replace this:
objAttach.SaveAsFile ("C:\Rossair3")

By this:
objAttach.SaveAsFile "C:\Rossair3\" & objAttch.DisplayName

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[romnew]

Hi PH and Gerry,
I thank you guys for your attention in this matter. It is nice to know that there are people prepared to help.It encourages one not to be discouraged and to carry on regardless.
I am happy to say that the problem is solved. By looking at the object model more closely and your input and other code which I happen to download, the following code works wonderfully.
It strips the attachment and places it in the folder you choose to have it in.
Here is the code:
Function StripAttachments()
Dim objOL As New Outlook.Application
Dim oNS As Object
Dim objMsg As Object
Dim objAttachments As Outlook.Attachments
Dim oInbox As Object
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolder As String

On Error Resume Next

Set oNS = objOL.GetNamespace("MAPI")
' Get the Inbox
Set oInbox = oNS.GetDefaultFolder(6)
' Get the Temp folder.
strFolder = GetTempDir()
If strFolder = "" Then
MsgBox "Could not get Temp folder", vbOKOnly
GoTo ExitSub
End If

' Check each selected item for attachments.
' If attachments exist, save them to the Temp
' folder and strip them from the item.
For Each objMsg In oInbox.Items

' This code only strips attachments from mail items.
If objMsg.Class = olMail Then


' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.count
If lngCount > 0 Then

' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strFile = objAttachments.item(i).FileName
' Combine with the path to the Temp folder.
strFile = strFolder & strFile
' Save the attachment as a file.
objAttachments.item(i).SaveAsFile strFile
' Delete the attachment.
objAttachments.item(i).Delete
Next i
End If
objMsg.Save
End If
Next

ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set oInbox = Nothing
Set objOL = Nothing
End Function
Please note that the call GetTempDir can really be omitted
by giving strfolder a value equal to the folder path where you save the attachments.

I value your inputs and thanks again.
Piet

 

[ntm0]

Piet, et. al;

I'm a newbie to the site who signed up immediately upon reading this thread. This code is EXACTLY what I have been looking for for 4 days.

Thanks for the help and I hope to return the favor someday.

Mike