Sub Routine That Copies Email Atatchments to Share Folder

[USTRAGNU1]

Good Day,

I have a sub routine which copies attachments from email items (.msg files) that I have placed in a share folder to another share folder.

Unfortunately, sometimes the mail item has Digital ID problems:
"Sorry, we're having trouble opening this item. this could be temporary, but if you see it again you might want to restart outlook. your digital id name cannot be found by the underlying security system".

I have not been able to find VBA error handling (EH) that enables the sub to continue when encountering this error. It seems like trying to open a password protected file without the password. Even though I have moved the email from Outlook to the share folder, the Outlook error still prevails. I admit I don't know much about the connection.

This kind of defeats the purpose of my automated process via my sub if I have to test each email by opening it to see if there is a certificate problem or not.

Have any of you encountered this before? Is there a work around with Access VBA error handling?

Would I be better able to bypass the certificate check with PowerShell scripting? Any insight into this would be most helpful.

Please let me know if you have questions or require additional information. Thank you for your time and effort.

Sincerely,
UTS

[Nauticalgent]

Perhaps you could post your code?

[twinnyfo]

UTS,

In order for you to copy attachments, you are forced to open the file--which will cause this digital ID problem. The reason that Access's VBA can't error trap this isbecause the errors are being generated by Outlook.

I've done some searching for PowerShell scripting of handling of attachments, but I think all of the scripts I've seen assume there is no digital ID/encryption. For obvious reasons, the encryption/Digital ID is there to prevent unauthorized access to these messages, so without a form of authenitcation, you will receive an error that prevents you from doing so.

Encryption assumes users will never want to automate anything they do on a regular basis.

Not sure if that helps! It's just kinda the way it is--unless someone has found a workaround for the encryption, which would result in a violation of the whole security thing....

[zmbd]

1) Is the VBA running in Outlook or Access
2) Need to see the actual code
3) To confirm, the messages (*.msg) reside in a network directory or local

[USTRAGNU1]

A person I know used to work Exchange and he suggested an Outlook Macro to strip the cert before the attachment gets copied to the network share folder, but he did not provide said macro. I am going to look around for something. I have also started working with someone on the Access VBA angle for this situation, and he is currently working through some error handling scenarios, so I will keep you posted and provide code if/when successful. Thank you.

[zmbd]

USTRAGNU1

{...}A person I know used to work Exchange and he suggested an Outlook Macro to strip the cert before the attachment gets copied to the network share folder,{...}

This is why I asked you if the code was running from Outlook or Access. If you were running from within Outlook then it would make more sense to save the Attachment directly from within Outlook where the authentication should have already been established. Then save the message out as plain text if needed.
-z

[zmbd]

Ok,
Found my code:

>This is in a module in Outlook running on an exchange server

I have this attached to a button in the ribbon; however, you should be able to have a rule run this as well.

Two VBA Scripts, both I've borrowed a bit from sources here on the Web - As a rule I don't save the messages out for various business reasons; however, I'm sure there's something along the same lines:

Option Explicit

Public Sub SaveAttachmentsToDirectory()
  Dim zAttachment As Outlook.Attachment
  Dim zSaveDirectory As String
  Dim zCurrentItem As Outlook.MailItem
  Dim zCount As Long
  '
On Error GoTo zErrTrap
  Set zCurrentItem = GetCurrentItem
  If TypeName(zCurrentItem) = "MailItem" Then
'
'Change the W to your directory path... this happens to be a mapped network location on my PC at work.
    zSaveDirectory = "W:\"
    '
    For Each zAttachment In zCurrentItem.Attachments
      zAttachment.SaveAsFile Path:=zSaveDirectory & zAttachment.DisplayName
      zCount = zCount + 1
    Next
  Else
    Err.Raise Number:=13, Source:="SaveAttachmentsToDirectory", Description:="Sorry that isn't an Outlook Mail Item"
  End If
  '
zCleanUP:
  On Error Resume Next
  If Not zCurrentItem Is Nothing Then Set zCurrentItem = Nothing
  MsgBox prompt:=zCount & " - Attachments Saved to: " & vbCrLf & zSaveDirectory, Title:="Action Completed"
Exit Sub
zErrTrap:
  MsgBox prompt:=Err.Source & vbCrLf & Err.Number & vbCrLf & Err.Description, Title:="Save Attachment Error"
Resume zCleanUP
End Sub

Dependent on:
(borrowed this directly from someone - it isn't my code; however, it's pretty slick and saved me a lot of time!

Public Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
 
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
        Case "Explorer"
            Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set GetCurrentItem = objApp.ActiveInspector.currentItem
    End Select
 
    Set objApp = Nothing
End Function

[USTRAGNU1]

Thanks for the code zmbd. Are these both in the same Outlook Module? I want to make sure of the structure and sequence. Thanks!
UTS

[zmbd]

You can put them in their own modules, the GetCurrentItem( ) function is declared as public so available to the entire project.
In fact, I have this function in its own module and call it from several different scripts to work with mailitems.

-z

[USTRAGNU1]

Oh yes, thanks! Have a good weekend! UTS

[USTRAGNU1]

Would it be too much to ask if you could modify "SaveAttachment sToDirectory" to target specific file extensions? I am only working with .csv files for this project...
UTS

[zmbd]

( revised code in post#14 )

I think that the following

If UCASE(Right(zAttachment.DisplayName,3))= "CSV" Then
  'the saving code here
End If

to pull the right three characters from the display name and If..Then clause to check should do the trick.

if not then we need to start a new thread with a cross-link back to this thread for context :)
BOL

[NeoPa]

That's good, but you could also use :

If zAttachment.DisplayName Like "*.CSV" Then

The case is almost never an issue (depending on the database or the OPTION COMPARE ... statement at the head of the code).

[zmbd]

Looking into the situation a bit more
Instead of Display name property we should use the file name - just dawned on me that these may be different.

Using NeoPa's suggestion (I wasn't aware that the Like would work in Outlook-VBA - thought it was an Access/SQL thing, just checked and it does work with Outlook - always learning something new!)

We have

If zAttachment.FileName Like "*.CSV" Then
   'the saving code here
End If

... much More Better ...

[USTRAGNU1]

Top notch, thanks so much! I will run and test and let you know what happens!
UTS