OL Sub through or by Excel Macro Call

Status
Not open for further replies.
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!!

corquando
 
K

Ken Slovak - [MVP - Outlook]

Outlook automation code can certainly run in Excel, just reference the

Outlook object library as a reference in the Excel VBA project and don't

assume an implicit Outlook.Application object. So your NameSpace code line

would use an Outlook.Application object that you instantiated.

Another, unsupported, method is to declare your Outlook VBA Sub as Public

and put it in the ThisOutlookSession class module. You still need an

Outlook.Application object though. Say your Outlook.Application object is

olApp then you'd call the Sub this way:

olApp.SASGET

"corquando" <corquando.5fbc006@outlookbanter.com> wrote in message

news:corquando.5fbc006@outlookbanter.com...

> 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!!

> > corquando
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
F VBA to move email from Non Default folder to Sub folders as per details given in excel file Outlook VBA and Custom Forms 9
O The Outlook API wrongfully shows an outlook folder to have zero sub-folders Outlook VBA and Custom Forms 1
O The Outlook API wrongfully shows an outlook folder to have zero sub-folders Outlook VBA and Custom Forms 2
D Is a sub folder under contacts necessary to be able to name an Address Book? Using Outlook 1
T Cannot connect to main BT email account, sub accts okay Using Outlook 0
R Call a Public Sub when a Flag is clicked on in the Message Preview pane Outlook VBA and Custom Forms 1
T Inbox Sub-Folder - Web Using Outlook 1
J Calling a Public sub-routine from the script editor via VB script Outlook VBA and Custom Forms 4
O Set columns for all (sub)folders Using Outlook 8
F VBA routine to write new sub routine in outlook Outlook VBA and Custom Forms 0
G how can Apply User-defined Field to all Sub Folder and Other Using Outlook 14
K Display sub-folders in body of outlook Using Outlook 1
D Sub folders of my Inbox collapsing Using Outlook 0
C Unread email count not displaying on Inbox sub-folders Using Outlook 0
W Shared inbox sub folders not visible when moved Using Outlook 3
G Creating Contact Sub Folders Using Outlook 2
B Sub Calendar-Color Coding Issue Using Outlook 4
T Missing sub-contact folders (distribution lists) Using Outlook 3
A Can i apply mail rules to inbox sub folders using VBA Outlook VBA and Custom Forms 2
D Monitor any changes to a sub-folder Outlook VBA and Custom Forms 4
G Categories - Sub Catergories Using Outlook 6
D How do I mail-enable a Public Folder Sub-folder in exchnage 2007 using shell ? Exchange Server Administration 0
R Private Sub Application_ItemSend() -Cannot make this code work in Outlook 2013 Using Outlook 0
A How to move responded emaisl automatically to sub folders in Outlook 2007 Using Outlook 0
J Incoming emails going to wrong sub-folder Using Outlook 4
T Unable to download e-mail sub account in OL 2010. No probs with Mailwasher Using Outlook 6
T Make sub folders of inbox appear BOLD when new mail arrives Using Outlook 10
D User cannot move email messages within Outlook Inbox folder and sub-folders. Using Outlook 0
G bcm 2007 sub folders BCM (Business Contact Manager) 1
A How to create fixed signatures for aliases that process through GMAIL? Outlook VBA and Custom Forms 0
S Macro for Loop through outlook unread emails Outlook VBA and Custom Forms 2
Y Images coming through as Cid:image in outlook Using Outlook 0
Jennifer Murphy Ctrl+Tab sometimes will not move through text a word at a time Using Outlook 1
Rupert Dragwater Scrolling through Directories hesitates Using Outlook 1
N Outlook Email Rule execution through shortcut keys (VBA codes) Using Outlook 1
A Outlook - Send New 20 Attachments through Email Using Outlook 4
A Outlook incompleted tasks has strike through Using Outlook 3
H Custom autoforwarding, sending mail through outlook office 365 Using Outlook 1
A Sending Emails Through Outlook From Multiple Email Addresses Using Outlook 1
T Can't send email through connected account (outlook.live.com) - goes to Drafts folder Using Outlook.com accounts in Outlook 3
Tim King Send mail from MSWord through Outlook Using Outlook 3
P Threat to being a spammer while sending automatic Emails through VBA Using Outlook 3
S Ask user to input email template through VBA Outlook VBA and Custom Forms 1
2 Task has a strike through but is not complete - how to remove? Using Outlook 1
Stefanos Update Sharepoint tasks through Outlook Using Outlook 2
L Outlook 2007 Search Through E-Mail Using Outlook 41
R Outlook Cache Mode Terminalserver disable through Registry Using Outlook 1
T Synchronize outlook appointments through web application. Using Outlook 1
L Cannot send emails through @live.co.uk account in outlook 2013 Using Outlook 0
L Cannot send emails through @live.co.uk account in outlook 2013 Using Outlook 2

Similar threads

Top