mmalinsky
04-13-2012, 06:50 AM
I have the following VBA code in an outlook module:
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Dim xl As Excel.Application
Public Sub PrintAttachments()
Dim myInbox As MAPIFolder
Dim mailItem As mailItem
Dim attchmt As Attachment
Dim attchmtName As String
Dim objSelection As Outlook.Selection
Dim objOL As Outlook.Application
Dim xlwkbk As Excel.Workbook
Dim xlwksht As Excel.Worksheet
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
Set myInbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each mailItem In objSelection
For Each attchmt In mailItem.Attachments
attchmtName = "C:\Temp\" & attchmt.FileName
attchmt.SaveAsFile attchmtName
Select Case Right(attchmt, Len(attchmt) - InStrRev(attchmt, "."))
Case "pdf"
Shell """C:\Program Files\Adobe\Acrobat 9.0\Acrobat\Acrobat.exe"" /t """ & (attchmtName) & """"
Case "xls", "xlsx"
' open the attachment
If xl Is Nothing Then
Set xl = CreateObject("Excel.Application")
End If
Set xlwkbk = xl.Workbooks.Open(attchmtName)
Set xlwksht = xlwkbk.Sheets(1)
' print worksheet
xlwksht.PrintOut
' close workbook
xlwkbk.Close False
End Select
Kill attchmtName
'End If
Next
Next
Set myInbox = Nothing
End Sub
Admittedly, I'm not a VBA guru (have done some in Excel). Most of the above is poached from message board threads, but I get the general idea of what is going on and the code does what I want with one exception. The code compiles and runs fine from within the VBA editor, but if I try to run it via Tools>Macro>Macros in Outlook, I get a Sub or Function not defined error. I am having difficulty debugging this since nothing is highlighted in the VBA editor to indicate what specifically is causing the error. Ideally, I'd like to be able to create a button on the Outlook toolbar to run this macro, but it won't work until the error is resolved.
Using Outlook 2007.
Any help is appreciated.
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
Dim xl As Excel.Application
Public Sub PrintAttachments()
Dim myInbox As MAPIFolder
Dim mailItem As mailItem
Dim attchmt As Attachment
Dim attchmtName As String
Dim objSelection As Outlook.Selection
Dim objOL As Outlook.Application
Dim xlwkbk As Excel.Workbook
Dim xlwksht As Excel.Worksheet
Set objOL = CreateObject("Outlook.Application")
Set objSelection = objOL.ActiveExplorer.Selection
Set myInbox = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each mailItem In objSelection
For Each attchmt In mailItem.Attachments
attchmtName = "C:\Temp\" & attchmt.FileName
attchmt.SaveAsFile attchmtName
Select Case Right(attchmt, Len(attchmt) - InStrRev(attchmt, "."))
Case "pdf"
Shell """C:\Program Files\Adobe\Acrobat 9.0\Acrobat\Acrobat.exe"" /t """ & (attchmtName) & """"
Case "xls", "xlsx"
' open the attachment
If xl Is Nothing Then
Set xl = CreateObject("Excel.Application")
End If
Set xlwkbk = xl.Workbooks.Open(attchmtName)
Set xlwksht = xlwkbk.Sheets(1)
' print worksheet
xlwksht.PrintOut
' close workbook
xlwkbk.Close False
End Select
Kill attchmtName
'End If
Next
Next
Set myInbox = Nothing
End Sub
Admittedly, I'm not a VBA guru (have done some in Excel). Most of the above is poached from message board threads, but I get the general idea of what is going on and the code does what I want with one exception. The code compiles and runs fine from within the VBA editor, but if I try to run it via Tools>Macro>Macros in Outlook, I get a Sub or Function not defined error. I am having difficulty debugging this since nothing is highlighted in the VBA editor to indicate what specifically is causing the error. Ideally, I'd like to be able to create a button on the Outlook toolbar to run this macro, but it won't work until the error is resolved.
Using Outlook 2007.
Any help is appreciated.