C
corquando
Greetings & Supplications, Oracles.
If what I've seen so far is true this may be harder than it should, but
I have to try.
The task is to call an Outlook sub from an Excel macro, or have the sub
BE an Excel macro that then does in Outlook what it's supposed to. The
object is to save 3 attachments from a particular weekly email to a
shared folder then move the email itself to another shared folder.
There will always be 3 (5 is right out) attachments.
This would seem elementary; I am growing dubious.
Anyway, here's the code so far:
Code:
--------------------
Sub SASGET()
On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim Carbon As New FileSystemObject
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Specials")
i = 0
If SubFolder.Items.Count = 0 Then
MsgBox "The Big Darn Report has not arrived." + vbCrLf + vbCrLf + _
"Please email the King and let him know.", vbInformation, _
"Nothing Found"
Exit Sub
End If
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
If Atmt.FileName = "Version1.csv" Then
FileName = "G:\Huge Folder\Medium Folder\Small Folder\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
If Atmt.FileName = "Version2.csv" Then
FileName = "G:\Huge Folder\Medium Folder\Small Folder\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
If Atmt.FileName = "Version3.csv" Then
FileName = "G:\Huge Folder\Medium Folder\Small Folder\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Carbon.MoveFile Item.FileName, "G:\Big Folder\Open Folder\Shared Folder\+Format(CDate(Now),""mm.dd.yy"")+"".msg"""
End If
Next Atmt
Next Item
If i 0 Then
MsgBox "Big Darn Report attachments were saved. This is good.", _
vbInformation, "WIN!"
End If
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
End Sub
--------------------
The code runs great (except for the Carbon.MoveFile statement - can't
seem to find the right set-up for that.) I just need to either have a
trigger in the Excel code that's running or have it be Excel code that
accomplishes the same task.
And there we have it. As always, many, many thanks!!
If what I've seen so far is true this may be harder than it should, but
I have to try.
The task is to call an Outlook sub from an Excel macro, or have the sub
BE an Excel macro that then does in Outlook what it's supposed to. The
object is to save 3 attachments from a particular weekly email to a
shared folder then move the email itself to another shared folder.
There will always be 3 (5 is right out) attachments.
This would seem elementary; I am growing dubious.
Anyway, here's the code so far:
Code:
--------------------
Sub SASGET()
On Error GoTo GetAttachments_err
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim Carbon As New FileSystemObject
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = Inbox.Folders("Specials")
i = 0
If SubFolder.Items.Count = 0 Then
MsgBox "The Big Darn Report has not arrived." + vbCrLf + vbCrLf + _
"Please email the King and let him know.", vbInformation, _
"Nothing Found"
Exit Sub
End If
For Each Item In SubFolder.Items
For Each Atmt In Item.Attachments
If Atmt.FileName = "Version1.csv" Then
FileName = "G:\Huge Folder\Medium Folder\Small Folder\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
If Atmt.FileName = "Version2.csv" Then
FileName = "G:\Huge Folder\Medium Folder\Small Folder\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
End If
If Atmt.FileName = "Version3.csv" Then
FileName = "G:\Huge Folder\Medium Folder\Small Folder\" & Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Carbon.MoveFile Item.FileName, "G:\Big Folder\Open Folder\Shared Folder\+Format(CDate(Now),""mm.dd.yy"")+"".msg"""
End If
Next Atmt
Next Item
If i 0 Then
MsgBox "Big Darn Report attachments were saved. This is good.", _
vbInformation, "WIN!"
End If
GetAttachments_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
End Sub
--------------------
The code runs great (except for the Carbon.MoveFile statement - can't
seem to find the right set-up for that.) I just need to either have a
trigger in the Excel code that's running or have it be Excel code that
accomplishes the same task.
And there we have it. As always, many, many thanks!!