Mister H
04-19-2016, 11:55 AM
Hi All:
I have been manipulating the code below and trying to get it working so that it will print my fellow Co-Workers email attachments. I have run into a snag. The attachment is an Excel Attachment BUT it is attached as a Read Only document with a password. So what happens is that the code will run and it will open Excel but it does not open the document until I either key in the password or open it as read only. Opening it as read only is probably the best for me. Is there a way to have Outlook VBA automatically open the attachment as read only WITHOUT POPPING up the excel prompt to type in the password? Basically I just want to bypass the Excel prompt for password and open as Read Only. The user that will run the code does not actually need to do anything in Excel to the document they just want it to print when they run the macro below.
I hope this makes sense. THANKS to anyone that can get me moving again :)
P.S. As you can see in the code I have tried typing the password (which is password) but Excel still hangs until I click open as Read Only or if I type in the password and click OK.
Option Explicit
Option Compare Text
#Const Develop = False
Dim xl As Excel.Application
Sub Print_MTO_Refund_Request()
'Constructed For the MTO Staff in April 2016
On Error GoTo ErrorHandler
Dim i As Long
Dim folder As Outlook.MAPIFolder
Dim itm As Object
Dim Msg As Outlook.MailItem
Dim msgAttachments As Outlook.Attachments
Dim msgAttach As Outlook.Attachment
Dim xlwkbk As Excel.Workbook
Dim xlwksht As Excel.Worksheet
Dim FileName As String
Set folder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("1) MTO Refund Request (for PRINTING)")
If folder Is Nothing Then GoTo ProgramExit
For i = folder.Items.Count To 1 Step -1
If TypeName(folder.Items(i)) = "MailItem" Then
Set Msg = folder.Items(i)
Set msgAttachments = Msg.Attachments
If msgAttachments.Count > 0 Then
For Each msgAttach In msgAttachments
If Right$(msgAttach.FileName, 3) = "xls" Or Right$(msgAttach.FileName, 4) = "xlsm" Then
FileName = Environ("temp") & "\" & msgAttach.FileName
msgAttach.SaveAsFile FileName
If xl Is Nothing Then
Set xl = CreateObject("Excel.Application")
End If
'The first line below is the line that is opening my Excel Attachment but the "password" is not being entered automatically
'I either need coding that will simply open the message as Read Only or will put the password in.
Set xlwkbk = xl.Workbooks.Open(FileName, , , , "password")
Set xlwksht = xlwkbk.Sheets("Refund Request")
xlwksht.PageSetup.LeftHeader = "Email Subject Line is: " & Msg.Subject '& " Message Received Date is: " & Msg.ReceivedTime
xlwksht.PageSetup.RightHeader = "Printed by " & Session.CurrentUser.Name
xlwksht.PageSetup.RightFooter = "Email Received From: " & Msg.SenderName & " on: " & Msg.ReceivedTime
xl.Run "PrintPage"
xlwkbk.Close False
Set xlwkbk = Nothing
End If
Msg.Move Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("2) MTO Refund Request (ALREADY Printed)")
Next msgAttach
End If
End If
Next i
ProgramExit:
If Not xlwkbk Is Nothing Then xlwkbk.Close False
If Not xl Is Nothing Then xl.Quit
If FileName <> "" Then Kill FileName
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description & Chr(10) & Chr(10) & "There is a possibility that not all your files were printed and moved. PLEASE check your Inbox folder titled: 1) ADIs to be Printed" & Chr(10) & Chr(10) & "NOTE: If not all files were Printed and Moved then try clicking the ' Print ADIs ' button again. They may print the 2nd time." & Chr(10) & Chr(10) & "If you keep getting this message then you will have to manually Print and Move the LAST email contained in your folder titled: 1) ADIs to be Printed" & Chr(10) & Chr(10) & "Problem MAY be:" & Chr(10) & "1) It may not be an ADI email 2) It may be an Archived email 3) The Journal sheet may be hidden" & Chr(10) & Chr(10) & "Once you move the first file manually you can once again click on the button titled Print ADIs" & Chr(10) & Chr(10) & "THANKS and Good Luck :-)"
Resume ProgramExit
End Sub
I have been manipulating the code below and trying to get it working so that it will print my fellow Co-Workers email attachments. I have run into a snag. The attachment is an Excel Attachment BUT it is attached as a Read Only document with a password. So what happens is that the code will run and it will open Excel but it does not open the document until I either key in the password or open it as read only. Opening it as read only is probably the best for me. Is there a way to have Outlook VBA automatically open the attachment as read only WITHOUT POPPING up the excel prompt to type in the password? Basically I just want to bypass the Excel prompt for password and open as Read Only. The user that will run the code does not actually need to do anything in Excel to the document they just want it to print when they run the macro below.
I hope this makes sense. THANKS to anyone that can get me moving again :)
P.S. As you can see in the code I have tried typing the password (which is password) but Excel still hangs until I click open as Read Only or if I type in the password and click OK.
Option Explicit
Option Compare Text
#Const Develop = False
Dim xl As Excel.Application
Sub Print_MTO_Refund_Request()
'Constructed For the MTO Staff in April 2016
On Error GoTo ErrorHandler
Dim i As Long
Dim folder As Outlook.MAPIFolder
Dim itm As Object
Dim Msg As Outlook.MailItem
Dim msgAttachments As Outlook.Attachments
Dim msgAttach As Outlook.Attachment
Dim xlwkbk As Excel.Workbook
Dim xlwksht As Excel.Worksheet
Dim FileName As String
Set folder = Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("1) MTO Refund Request (for PRINTING)")
If folder Is Nothing Then GoTo ProgramExit
For i = folder.Items.Count To 1 Step -1
If TypeName(folder.Items(i)) = "MailItem" Then
Set Msg = folder.Items(i)
Set msgAttachments = Msg.Attachments
If msgAttachments.Count > 0 Then
For Each msgAttach In msgAttachments
If Right$(msgAttach.FileName, 3) = "xls" Or Right$(msgAttach.FileName, 4) = "xlsm" Then
FileName = Environ("temp") & "\" & msgAttach.FileName
msgAttach.SaveAsFile FileName
If xl Is Nothing Then
Set xl = CreateObject("Excel.Application")
End If
'The first line below is the line that is opening my Excel Attachment but the "password" is not being entered automatically
'I either need coding that will simply open the message as Read Only or will put the password in.
Set xlwkbk = xl.Workbooks.Open(FileName, , , , "password")
Set xlwksht = xlwkbk.Sheets("Refund Request")
xlwksht.PageSetup.LeftHeader = "Email Subject Line is: " & Msg.Subject '& " Message Received Date is: " & Msg.ReceivedTime
xlwksht.PageSetup.RightHeader = "Printed by " & Session.CurrentUser.Name
xlwksht.PageSetup.RightFooter = "Email Received From: " & Msg.SenderName & " on: " & Msg.ReceivedTime
xl.Run "PrintPage"
xlwkbk.Close False
Set xlwkbk = Nothing
End If
Msg.Move Outlook.Session.GetDefaultFolder(olFolderInbox).Folders("2) MTO Refund Request (ALREADY Printed)")
Next msgAttach
End If
End If
Next i
ProgramExit:
If Not xlwkbk Is Nothing Then xlwkbk.Close False
If Not xl Is Nothing Then xl.Quit
If FileName <> "" Then Kill FileName
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description & Chr(10) & Chr(10) & "There is a possibility that not all your files were printed and moved. PLEASE check your Inbox folder titled: 1) ADIs to be Printed" & Chr(10) & Chr(10) & "NOTE: If not all files were Printed and Moved then try clicking the ' Print ADIs ' button again. They may print the 2nd time." & Chr(10) & Chr(10) & "If you keep getting this message then you will have to manually Print and Move the LAST email contained in your folder titled: 1) ADIs to be Printed" & Chr(10) & Chr(10) & "Problem MAY be:" & Chr(10) & "1) It may not be an ADI email 2) It may be an Archived email 3) The Journal sheet may be hidden" & Chr(10) & Chr(10) & "Once you move the first file manually you can once again click on the button titled Print ADIs" & Chr(10) & Chr(10) & "THANKS and Good Luck :-)"
Resume ProgramExit
End Sub