Outlook VBA

[ApplePirate]

Im using this bit of code to move attachments from outlook to a specified folder.

------------------------------------------------------
------------------------------------------------------
option explicit

Function Item_Open()

dim objNameSpace
dim objFolder
dim objItem
dim objAttachment
dim intIndex
dim intIndex2
dim strFiles

set objNameSpace = Application.GetNameSpace("MAPI&quot
set objFolder = objNameSpace.PickFolder

for intIndex = 1 to objFolder.Items.Count
set objItem = objFolder.Items(intIndex)
if objItem is nothing then
else
for intIndex2 = 1 to objItem.Attachments.Count
set objAttachment = objItem.Attachments(intIndex2)
if objAttachment is nothing then
else
objAttachment.SaveAsFile "c:import\" & objAttachment.FileName
strFiles = strFiles & objAttachment.FileName & vbCR
end if
next
end if
next

Item.Body = strFiles

End Function

------------------------------------------------------
------------------------------------------------------

the line "set objFolder = objNameSpace.PickFolder" produces a pop up browser window from which i choose a folder. Is there a way of setting a folder in the script so i dont have to choose from the browser.



Never ever, bloody anything, ever

 

[SBendBuckeye]

It doesn't appear that you need the objFolder portion of your code. It looks like it is already saving it to c:\import. Try removing the outside for loop and see what happens.

Good LucK!

 

[ApplePirate]

The code is supposed to remove all e-mail attachments from a certain folder and place them on my hard drive

The destination folder is set as c:/import which is on my hard drive but the folder from which outlook strips the attachments is obtained from a browser window which i then navigate and select, the code then strips all attachments and places them in C:/import.
What i need is for the code not to ask for a folder within outlook but to go straight to a preset folder

Never ever, bloody anything, ever

 

[robcarr]

I have had to similiar before, the code below goes to the folder called attachments which is a sub folder in Inbox and counts all unread and read emails, all you would need to do is adjsut for attachments.

Hope this helps.


Sub MarkEmails()
Dim ffldinbox As Object
Dim objApp As Outlook.Application
Dim ns As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim fldInbox As Outlook.MAPIFolder
Dim mi As Outlook.MailItem
Dim unreadm As Integer, readm As Integer
Set objApp = GetObject(, "Outlook.Application&quot
Set ns = objApp.GetNamespace("MAPI&quot
Set fldInbox = ns.GetDefaultFolder(olFolderInbox).Parent
Set ffldinbox = fldInbox.Folders("Attachments&quot
For Each fld In ffldinbox.Folders
unreadm = 0: readm = 0
For Each mi In fld.Items

If mi.UnRead Then
unreadm = unreadm + 1
Else
readm = readm + 1
End If
Next


Thanks Rob.

 

[ApplePirate]

Ive tried this code alone and it gives an error
"expected end of statement line 2"
any ideas?

 

[ApplePirate]

Someone must be able to help me with this, Ive been trying for three days and still cant do it

 

[robcarr]

The coding I provided works fine on my NT system using excel 2000, The coding I use is ran through Excel to get the info required.

what you need to do is where the "set objFolder = objNameSpace.PickFolder" line is replace it with the following
Set ns = objApp.GetNamespace("MAPI&quot
Set fldInbox = ns.GetDefaultFolder(olFolderInbox).Parent
Set ffldinbox = fldInbox.Folders("Attachments&quot

you need to set the variables, you should be able to adapt my coding and it should look straight at the folder you have specified.

Rob.




Thanks Rob.

 

[ApplePirate]

I have tried to do this, but still get an error:-
"could not complete the operation: one or more parameter values are not valid"

can anyone tell me if this code looks right?


Function Item_Open()
dim objNameSpace
dim objFolder
dim objItem
dim objAttachment
dim intIndex
dim intIndex2
dim strFiles
dim folder
dim mi
dim fldInbox
set objNameSpace = Application.GetNameSpace("MAPI&quot
Set fldInbox = objNameSpace.GetDefaultFolder(olFolderInbox).Parent
Set objFolder = fldInbox.Folders("UUPLC&quot
for intIndex = 1 to objFolder.Items.Count
set objItem = objFolder.Items(intIndex)
if objItem is nothing Then
else
for intIndex2 = 1 to objItem.Attachments.Count
set objAttachment = objItem.Attachments(intIndex2)
if objAttachment is nothing then
else
objAttachment.SaveAsFile "T:\Developer Partnerships\File Loading Area\Uuplc\" & objAttachment.FileName
strFiles = strFiles & objAttachment.FileName & vbCR
end if
next
end if
next
Item.Body = strFiles
End Function

 

[tatarrila]

Hi
I have been tring your code and I have adapted it, so this one works fine.
however it don't work if we hqve a msg were we have pasted some excel cells.
Let me know if it works for you.


Dim ns As Outlook.NameSpace
Dim objApp As Outlook.Application
Dim ffldinbox As Object
Dim emailBody As String
Set objApp = GetObject(, "Outlook.Application&quot
Dim objNameSpace
Dim objFolder
Dim objItem
Dim objAttachment
Dim intIndex
Dim intIndex2
Dim strFiles
Dim folder
Dim mi
Dim fldInbox
Set ns = objApp.GetNamespace("MAPI&quot
Set fldInbox = ns.GetDefaultFolder(olFolderInbox).Parent
Set objFolder = fldInbox.Folders("inbox&quot

For intIndex = 1 To objFolder.Items.Count
Set objItem = objFolder.Items(intIndex)
If objItem Is Nothing Then
Else
For intIndex2 = 1 To objItem.Attachments.Count
Set objAttachment = objItem.Attachments(intIndex2)
If objAttachment Is Nothing Then
Else
objAttachment.SaveAsFile "C:\testes\" & objAttachment.FileName
strFiles = strFiles & objAttachment.FileName & vbCr
End If
Next
End If
Next
emailBody = strFiles
MsgBox "já esta"

Antonio Garrido

 

[ApplePirate]

Antonio,
thanks for trying this, but ive come to the conclusion that im either using an older version of outlook or im using a crippled version. what appears to be valid code is being rejected with "expected end of statement" on line one. this is because my outlook doesnt seem to like declarations with "dim Variable as object" etc it will accept "dim Variable" but not the "as object" tag. If i remove those tags from your code i then get an "one or more parameter values are not valid".
I get the feeling that this is not possible to do with the current system setup i have at work.
thanks for your time and help