Hi,
the following code copies and pastes any excel attachments from a subfolder (called "Test Folder" in Outlook, into individual new excel workbooks under the path Y:\Scripts3\copy, the first being copy1, the second copy2, etc.
However, I would like them to all go in 1 worksheet, one after another, not separate workbooks. Does anyone know how to do this?
Many thanks,
Tim
Sub SaveAttachments()
Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim I As Long
Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myFolder = myFolder.Folders("Test Folder")
For Each myItem In myFolder.Items
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments
I = 1 + 1
myAttachment.SaveAsFile "Y:\Scripts3\copy" & I & ".xls"
Next
End If
Next
End Sub
the following code copies and pastes any excel attachments from a subfolder (called "Test Folder" in Outlook, into individual new excel workbooks under the path Y:\Scripts3\copy, the first being copy1, the second copy2, etc.
However, I would like them to all go in 1 worksheet, one after another, not separate workbooks. Does anyone know how to do this?
Many thanks,
Tim
Sub SaveAttachments()
Dim myOlapp As Outlook.Application
Dim myNameSpace As Outlook.Namespace
Dim myFolder As Outlook.MAPIFolder
Dim myItem As Outlook.MailItem
Dim myAttachment As Outlook.Attachment
Dim I As Long
Set myOlapp = CreateObject("Outlook.Application")
Set myNameSpace = myOlapp.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myFolder = myFolder.Folders("Test Folder")
For Each myItem In myFolder.Items
If myItem.Attachments.Count <> 0 Then
For Each myAttachment In myItem.Attachments
I = 1 + 1
myAttachment.SaveAsFile "Y:\Scripts3\copy" & I & ".xls"
Next
End If
Next
End Sub