Log in

View Full Version : Error in outlook script



l_nk
09-02-2011, 04:21 AM
I am new to VBA so I don't know much. This script is meant to move any attachmens to a folder but whenever I try to run it the error box says 'For' without 'Next'. Any help would be much appriecetated.
Sub attach()
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
If Inbox.Items.Count >= 0 Then
For Each Atmt In Item.attachments
FileName = "C:\Email Attachments\" & _
Format(Item.CreationTime, "yyyymmdd_hhnnss_") & Atmt.FileName
Atmt.SaveAsFile FileName

If Not Inbox.Items.Count >= 0 Then GoTo Ln1

End Sub

JP2112
09-06-2011, 07:35 AM
Welcome to the board. Please use code tags when posting VBA code, it makes it easier to read. Also, there is an Outlook forum specifically for Outlook related questions: http://www.vbaexpress.com/forum/forumdisplay.php?f=18

It looks like you're trying to loop through your default Inbox and save attachments to a folder on disk, then remove the attachment from the email. If so, try this:

Sub SaveAttachments()
Dim ns As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim numberOfItems As Long
Dim i As Long
Dim j As Long
Dim itm As Object
Dim msg As Outlook.mailItem
Dim atmts As Outlook.attachments
Dim atmt As Outlook.Attachment
Dim fileName As String

Set ns = GetNamespace("MAPI")
Set myInbox = ns.GetDefaultFolder(olFolderInbox)
numberOfItems = myInbox.Items.Count

' check that there are items present
If numberOfItems > 0 Then
' loop through items, look for emails
For i = 1 To numberOfItems
Set itm = myInbox.Items.Item(i)
If TypeName(itm) = "MailItem" Then
Set msg = itm
Set atmts = msg.attachments
' loop backwards through attachments, save and remove from message
For j = atmts.Count To 1 Step -1
Set atmt = atmts.Item(j)
fileName = "C:\Email Attachments\" & _
Format(msg.CreationTime, "yyyymmdd_hhnnss_") & atmt.fileName
atmt.SaveAsFile fileName
atmt.Delete
Next j
End If
Next i
End If
End Sub

A 'For' loop requires a 'Next' statement to tell the loop where to end and return to the 'For' statement.

You wrote "If Inbox.Items.Count >= 0 Then" which means the code will enter the For loop even if the Inbox items count is zero. I think you meant "If Inbox.Items.Count > 0 Then".

l_nk
09-06-2011, 02:15 PM
Thanks heaps. I was also wondering if instead of a loop how you could trigger the macro whenever you recieved a attachment and then the macro ends itself with a rule. Help appreciated.

JP2112
09-07-2011, 07:33 AM
Technically, you do not receive attachments, you receive what Outlook calls "items". I have some stock event code which you would modify to save the attachments of the newly added item:

http://www.codeforexcelandoutlook.com/outlook-vba/stock-event-code/

Using the code found at that link, you can use the code in my response above (the part that starts with "Set itm = myInbox.Items.Item(i)") with little modification.

l_nk
09-08-2011, 12:57 AM
I'm sorry but I'm having trouble intergrating the two scripts, I keep on getting errors :banghead:. If its not to much to ask could you please help me.

Also I was wondering how you could get the script to run on start up of Outlook or if it already did.

Thanks

JP2112
09-08-2011, 07:53 AM
Paste this into the ThisOutlookSession module and restart Outlook.

Private WithEvents Items As Outlook.Items
Function GetNS(ByRef app As Outlook.Application) As Outlook.NameSpace
Set GetNS = app.GetNamespace("MAPI")
End Function
Function GetItems(olNS As Outlook.NameSpace, folder As OlDefaultFolders) As Outlook.Items
Set GetItems = olNS.GetDefaultFolder(folder).Items
End Function
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
Set Items = GetItems(GetNS(olApp), olFolderInbox)
End Sub
Private Sub Items_ItemAdd(ByVal item As Object)
On Error GoTo ErrorHandler
Dim Msg As Outlook.mailItem
Dim atmts As Outlook.attachments
Dim atmt As Outlook.Attachment
Dim j As Long
Dim FileName As String
If TypeName(item) = "MailItem" Then
Set Msg = item
Set atmts = Msg.attachments
' loop backwards through attachments, save and remove from message
For j = atmts.Count To 1 Step -1
Set atmt = atmts.item(j)
FileName = "C:\Email Attachments\" & _
Format(Msg.CreationTime, "yyyymmdd_hhnnss_") & atmt.FileName
atmt.SaveAsFile FileName
atmt.Delete
Next j
End If
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub

The event handler runs whenever an item is added to the default Inbox, presumably that is when items are received. To run the same code when you start Outlook, just call the SaveAttachments procedure in the Application_Startup event.