I have 2 questions. The first one is 1) My macro does the job, but it really
seems to repeat itself. Is there a better way of writing it? My second
question is 2) we originally were just looking to identify .msg attachments.
Now however, we want to identify and separately process several other types
of attachments (.htm, .zip). I'm not very knowlegeable in vba. What is the
cleanest way to go from working with one extension to working with several?
I appreciate your help.

Public Sub StripAttachments()
Dim objApp As Outlook.Application
Dim ns As Outlook.NameSpace
Dim Item As Object
Dim objAttachments As Outlook.attachments
Dim i As Long
Dim lngCount As Long
Dim strfile As String
Dim tempfile As String
Dim tempdir As String
Dim del As String ' ttimport delete parameter
Dim app As String ' ttimport application parameter
Dim result
Dim fso
Dim fil
Dim ext As String
Dim strsubject As String
Dim FileName As String
Dim path As String
Dim Response As VbMsgBoxResult

On Error Resume Next

Set fso = CreateObject("Scripting.filesystemobject")
Set ns = GetNamespace("MAPI")
' Instantiate an Outlook Application object.
Set objApp = CreateObject("Outlook.Application")
Set objApp = Application

' Get the collection of selected objects.
Select Case TypeName(objApp.ActiveWindow)
Case "Explorer"
Set Item = objApp.ActiveExplorer.Selection.Item(1)
Case "Inspector"
Set Item = objApp.ActiveInspector.CurrentItem
Case Else
'
End Select

'Call SaveEmailNoAtt
app = "/a=clmdoc"

Set objAttachments = Item.attachments
lngCount = objAttachments.Count
If lngCount > 0 Then
For i = lngCount To 1 Step -1
strfile = objAttachments.Item(i).FileName
If Right(strfile, 3) = "msg" Then
If (FileExists("C:\Program Files\RLI\MSGImport.txt")) Then
MsgBox "This email contains attachments that are emails." &
vbCrLf & "Please process these attachments separately.", vbOKOnly +
vbExclamation
Else
Response = MsgBox("This email requires special
handling and must be processed by ClaimHelp." & vbCrLf & "Do you wish to
forward to ClaimHelp now?", vbYesNo + vbExclamation)
If Response = vbYes Then
ForwardEmail
'MsgBox "This email requires special handling,
please forward it to ClaimHelp for processing.", vbOKOnly + vbExclamation
Else
End If
Exit Sub
End If
End If
Next i
End If

' Get the Temp folder.
tempdir = ("c:\temp\outlookimport\")
CheckFolder

strsubject = Item.Subject
FileName = StripIllegalChar(strsubject)
FileName = Replace(FileName, " ", "_")
If FileName = "" Then
FileName = "No Subject"
End If

If fso.GetExtensionName(FileName) = "" Then
FileName = FileName & ".rtf"
End If

ext = fso.GetExtensionName(FileName)
path = fso.BuildPath(tempdir, FileName)

Do While fso.FileExists(path)
tempfile = fso.GetTempName
tempfile = fso.GetBaseName(tempfile) & "." & ext
path = fso.BuildPath(tempdir, tempfile)
Loop

Item.SaveAs path, olRTF


Set fil = fso.GetFile(path)
path = fil.ShortPath
Set fil = Nothing

ExecCmd "ttimport.exe " & app & " " & path
Kill (path)

' Get the Attachments collection of the item.
If lngCount > 0 Then
' We need to use a count down loop for
' removing items from a collection. Otherwise,
' the loop counter gets confused and only every
' other item is removed.
For i = lngCount To 1 Step -1
' Get the file name.
strfile = objAttachments.Item(i).FileName
If Right(strfile, 3) <> "msg" Then
strfile = Replace(strfile, " ", "_")
'Combine with the path to the Temp folder.
strfile = tempdir & strfile
' Save the attachment as a file.
objAttachments.Item(i).SaveAsFile strfile
ExecCmd "ttimport.exe " & app & " " & strfile
Kill (strfile)
End If
Next i
End If
'Item.Save

If lngCount > 0 Then
For i = lngCount To 1 Step -1
strfile = objAttachments.Item(i).FileName
If Right(strfile, 3) = "msg" Then
MsgBox "Email and attachments Saved Individually." & vbCrLf
& "Please verify your documents imported correctly." & vbCrLf & "Remember to
process the attached email separately!", vbOKOnly + vbExclamation
Exit Sub
Else
MsgBox "Email and attachments Saved Individually." & vbCrLf
& "Please verify your documents imported correctly.", vbOKOnly
Exit Sub
End If
Next i
End If
ExitSub:
Set objAttachments = Nothing
Set Item = Nothing
Set objApp = Nothing

'MsgBox "Email and attachments Saved Individually. Please verify your
documents imported correctly."

End Sub

1) Rather than force us to read through all your code, could you explain
what job the macro is supposed to accomplish?

2) Parse the attachment file name to extract the extension then use a series
of If ... Then ... ElseIf statements or, better, a Select Case block.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"hlock" <(E-Mail Removed)> wrote in message
news:4556BBA2-1984-441D-B244-(E-Mail Removed)...
>I have 2 questions. The first one is 1) My macro does the job, but it
>really
> seems to repeat itself. Is there a better way of writing it? My second
> question is 2) we originally were just looking to identify .msg
> attachments.
> Now however, we want to identify and separately process several other
> types
> of attachments (.htm, .zip). I'm not very knowlegeable in vba. What is
> the
> cleanest way to go from working with one extension to working with
> several?
> I appreciate your help.
>
> Public Sub StripAttachments()
> Dim objApp As Outlook.Application
> Dim ns As Outlook.NameSpace
> Dim Item As Object
> Dim objAttachments As Outlook.attachments
> Dim i As Long
> Dim lngCount As Long
> Dim strfile As String
> Dim tempfile As String
> Dim tempdir As String
> Dim del As String ' ttimport delete parameter
> Dim app As String ' ttimport application parameter
> Dim result
> Dim fso
> Dim fil
> Dim ext As String
> Dim strsubject As String
> Dim FileName As String
> Dim path As String
> Dim Response As VbMsgBoxResult
>
> On Error Resume Next
>
> Set fso = CreateObject("Scripting.filesystemobject")
> Set ns = GetNamespace("MAPI")
> ' Instantiate an Outlook Application object.
> Set objApp = CreateObject("Outlook.Application")
> Set objApp = Application
>
> ' Get the collection of selected objects.
> Select Case TypeName(objApp.ActiveWindow)
> Case "Explorer"
> Set Item = objApp.ActiveExplorer.Selection.Item(1)
> Case "Inspector"
> Set Item = objApp.ActiveInspector.CurrentItem
> Case Else
> '
> End Select
>
> 'Call SaveEmailNoAtt
> app = "/a=clmdoc"
>
> Set objAttachments = Item.attachments
> lngCount = objAttachments.Count
> If lngCount > 0 Then
> For i = lngCount To 1 Step -1
> strfile = objAttachments.Item(i).FileName
> If Right(strfile, 3) = "msg" Then
> If (FileExists("C:\Program Files\RLI\MSGImport.txt")) Then
> MsgBox "This email contains attachments that are emails." &
> vbCrLf & "Please process these attachments separately.", vbOKOnly +
> vbExclamation
> Else
> Response = MsgBox("This email requires special
> handling and must be processed by ClaimHelp." & vbCrLf & "Do you wish to
> forward to ClaimHelp now?", vbYesNo + vbExclamation)
> If Response = vbYes Then
> ForwardEmail
> 'MsgBox "This email requires special handling,
> please forward it to ClaimHelp for processing.", vbOKOnly + vbExclamation
> Else
> End If
> Exit Sub
> End If
> End If
> Next i
> End If
>
> ' Get the Temp folder.
> tempdir = ("c:\temp\outlookimport\")
> CheckFolder
>
> strsubject = Item.Subject
> FileName = StripIllegalChar(strsubject)
> FileName = Replace(FileName, " ", "_")
> If FileName = "" Then
> FileName = "No Subject"
> End If
>
> If fso.GetExtensionName(FileName) = "" Then
> FileName = FileName & ".rtf"
> End If
>
> ext = fso.GetExtensionName(FileName)
> path = fso.BuildPath(tempdir, FileName)
>
> Do While fso.FileExists(path)
> tempfile = fso.GetTempName
> tempfile = fso.GetBaseName(tempfile) & "." & ext
> path = fso.BuildPath(tempdir, tempfile)
> Loop
>
> Item.SaveAs path, olRTF
>
>
> Set fil = fso.GetFile(path)
> path = fil.ShortPath
> Set fil = Nothing
>
> ExecCmd "ttimport.exe " & app & " " & path
> Kill (path)
>
> ' Get the Attachments collection of the item.
> If lngCount > 0 Then
> ' We need to use a count down loop for
> ' removing items from a collection. Otherwise,
> ' the loop counter gets confused and only every
> ' other item is removed.
> For i = lngCount To 1 Step -1
> ' Get the file name.
> strfile = objAttachments.Item(i).FileName
> If Right(strfile, 3) <> "msg" Then
> strfile = Replace(strfile, " ", "_")
> 'Combine with the path to the Temp folder.
> strfile = tempdir & strfile
> ' Save the attachment as a file.
> objAttachments.Item(i).SaveAsFile strfile
> ExecCmd "ttimport.exe " & app & " " & strfile
> Kill (strfile)
> End If
> Next i
> End If
> 'Item.Save
>
> If lngCount > 0 Then
> For i = lngCount To 1 Step -1
> strfile = objAttachments.Item(i).FileName
> If Right(strfile, 3) = "msg" Then
> MsgBox "Email and attachments Saved Individually." & vbCrLf
> & "Please verify your documents imported correctly." & vbCrLf & "Remember
> to
> process the attached email separately!", vbOKOnly + vbExclamation
> Exit Sub
> Else
> MsgBox "Email and attachments Saved Individually." & vbCrLf
> & "Please verify your documents imported correctly.", vbOKOnly
> Exit Sub
> End If
> Next i
> End If
> ExitSub:
> Set objAttachments = Nothing
> Set Item = Nothing
> Set objApp = Nothing
>
> 'MsgBox "Email and attachments Saved Individually. Please verify your
> documents imported correctly."
>
> End Sub
>

Sure - using our document repository executable, the macro saves the email by
itself as an rtf to our document repository, then it saves each attachment to
our document repository. The macro runs through the attachments 3x to look
at the attachments:

1. The macro looks at each attachment. If there is a .msg attachment and
the user has a particular file on their computer, they get a message, but the
macro continues. If the user does not have the file on their computer, the
macro ends.
2. The macro processes each attachment, except any attachment that is a
..msg, and imports it to our document repository.
3. The macro looks at each attachment. If there is a .msg attachment, it
reminds the user to import the .msg attachment separately. If there isn't
any .msg attachments, it just reminds the user to check the imports.

I guess it's the running through of the attachments 3 different times that
seems redundant. However, it doesn't seem to slow down the macro and it
works. It just isn't very clean.

As for parsing the attachment file - is that using the right function and
taking the last 3 letters of the file? Thank you so much for your help.

"Sue Mosher [MVP]" wrote:

> 1) Rather than force us to read through all your code, could you explain
> what job the macro is supposed to accomplish?
>
> 2) Parse the attachment file name to extract the extension then use a series
> of If ... Then ... ElseIf statements or, better, a Select Case block.
> --
> Sue Mosher, Outlook MVP
> Author of Microsoft Outlook 2007 Programming:
> Jumpstart for Power Users and Administrators
> http://www.outlookcode.com/article.aspx?id=54
>
>
> "hlock" <(E-Mail Removed)> wrote in message
> news:4556BBA2-1984-441D-B244-(E-Mail Removed)...
> >I have 2 questions. The first one is 1) My macro does the job, but it
> >really
> > seems to repeat itself. Is there a better way of writing it? My second
> > question is 2) we originally were just looking to identify .msg
> > attachments.
> > Now however, we want to identify and separately process several other
> > types
> > of attachments (.htm, .zip). I'm not very knowlegeable in vba. What is
> > the
> > cleanest way to go from working with one extension to working with
> > several?
> > I appreciate your help.
> >
> > Public Sub StripAttachments()
> > Dim objApp As Outlook.Application
> > Dim ns As Outlook.NameSpace
> > Dim Item As Object
> > Dim objAttachments As Outlook.attachments
> > Dim i As Long
> > Dim lngCount As Long
> > Dim strfile As String
> > Dim tempfile As String
> > Dim tempdir As String
> > Dim del As String ' ttimport delete parameter
> > Dim app As String ' ttimport application parameter
> > Dim result
> > Dim fso
> > Dim fil
> > Dim ext As String
> > Dim strsubject As String
> > Dim FileName As String
> > Dim path As String
> > Dim Response As VbMsgBoxResult
> >
> > On Error Resume Next
> >
> > Set fso = CreateObject("Scripting.filesystemobject")
> > Set ns = GetNamespace("MAPI")
> > ' Instantiate an Outlook Application object.
> > Set objApp = CreateObject("Outlook.Application")
> > Set objApp = Application
> >
> > ' Get the collection of selected objects.
> > Select Case TypeName(objApp.ActiveWindow)
> > Case "Explorer"
> > Set Item = objApp.ActiveExplorer.Selection.Item(1)
> > Case "Inspector"
> > Set Item = objApp.ActiveInspector.CurrentItem
> > Case Else
> > '
> > End Select
> >
> > 'Call SaveEmailNoAtt
> > app = "/a=clmdoc"
> >
> > Set objAttachments = Item.attachments
> > lngCount = objAttachments.Count
> > If lngCount > 0 Then
> > For i = lngCount To 1 Step -1
> > strfile = objAttachments.Item(i).FileName
> > If Right(strfile, 3) = "msg" Then
> > If (FileExists("C:\Program Files\RLI\MSGImport.txt")) Then
> > MsgBox "This email contains attachments that are emails." &
> > vbCrLf & "Please process these attachments separately.", vbOKOnly +
> > vbExclamation
> > Else
> > Response = MsgBox("This email requires special
> > handling and must be processed by ClaimHelp." & vbCrLf & "Do you wish to
> > forward to ClaimHelp now?", vbYesNo + vbExclamation)
> > If Response = vbYes Then
> > ForwardEmail
> > 'MsgBox "This email requires special handling,
> > please forward it to ClaimHelp for processing.", vbOKOnly + vbExclamation
> > Else
> > End If
> > Exit Sub
> > End If
> > End If
> > Next i
> > End If
> >
> > ' Get the Temp folder.
> > tempdir = ("c:\temp\outlookimport\")
> > CheckFolder
> >
> > strsubject = Item.Subject
> > FileName = StripIllegalChar(strsubject)
> > FileName = Replace(FileName, " ", "_")
> > If FileName = "" Then
> > FileName = "No Subject"
> > End If
> >
> > If fso.GetExtensionName(FileName) = "" Then
> > FileName = FileName & ".rtf"
> > End If
> >
> > ext = fso.GetExtensionName(FileName)
> > path = fso.BuildPath(tempdir, FileName)
> >
> > Do While fso.FileExists(path)
> > tempfile = fso.GetTempName
> > tempfile = fso.GetBaseName(tempfile) & "." & ext
> > path = fso.BuildPath(tempdir, tempfile)
> > Loop
> >
> > Item.SaveAs path, olRTF
> >
> >
> > Set fil = fso.GetFile(path)
> > path = fil.ShortPath
> > Set fil = Nothing
> >
> > ExecCmd "ttimport.exe " & app & " " & path
> > Kill (path)
> >
> > ' Get the Attachments collection of the item.
> > If lngCount > 0 Then
> > ' We need to use a count down loop for
> > ' removing items from a collection. Otherwise,
> > ' the loop counter gets confused and only every
> > ' other item is removed.
> > For i = lngCount To 1 Step -1
> > ' Get the file name.
> > strfile = objAttachments.Item(i).FileName
> > If Right(strfile, 3) <> "msg" Then
> > strfile = Replace(strfile, " ", "_")
> > 'Combine with the path to the Temp folder.
> > strfile = tempdir & strfile
> > ' Save the attachment as a file.
> > objAttachments.Item(i).SaveAsFile strfile
> > ExecCmd "ttimport.exe " & app & " " & strfile
> > Kill (strfile)
> > End If
> > Next i
> > End If
> > 'Item.Save
> >
> > If lngCount > 0 Then
> > For i = lngCount To 1 Step -1
> > strfile = objAttachments.Item(i).FileName
> > If Right(strfile, 3) = "msg" Then
> > MsgBox "Email and attachments Saved Individually." & vbCrLf
> > & "Please verify your documents imported correctly." & vbCrLf & "Remember
> > to
> > process the attached email separately!", vbOKOnly + vbExclamation
> > Exit Sub
> > Else
> > MsgBox "Email and attachments Saved Individually." & vbCrLf
> > & "Please verify your documents imported correctly.", vbOKOnly
> > Exit Sub
> > End If
> > Next i
> > End If
> > ExitSub:
> > Set objAttachments = Nothing
> > Set Item = Nothing
> > Set objApp = Nothing
> >
> > 'MsgBox "Email and attachments Saved Individually. Please verify your
> > documents imported correctly."
> >
> > End Sub
> >
>
>
> .
>

I agree that it's inefficient to handle each attachment 3 times. You should
consolidate your operations into one loop.

Most file extensions are 3 characters, so you can use Right() and succeed
most of the time. An even more certain approach would be to use the
InStrRev() function to locate the rightmost period in the file name and then
use Mid() to extract all characters to the right of the period.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"hlock" <(E-Mail Removed)> wrote in message
news:4D722AAE-554B-4CE5-AA03-(E-Mail Removed)...
> Sure - using our document repository executable, the macro saves the email
> by
> itself as an rtf to our document repository, then it saves each attachment
> to
> our document repository. The macro runs through the attachments 3x to
> look
> at the attachments:
>
> 1. The macro looks at each attachment. If there is a .msg attachment and
> the user has a particular file on their computer, they get a message, but
> the
> macro continues. If the user does not have the file on their computer,
> the
> macro ends.
> 2. The macro processes each attachment, except any attachment that is a
> .msg, and imports it to our document repository.
> 3. The macro looks at each attachment. If there is a .msg attachment, it
> reminds the user to import the .msg attachment separately. If there isn't
> any .msg attachments, it just reminds the user to check the imports.
>
> I guess it's the running through of the attachments 3 different times that
> seems redundant. However, it doesn't seem to slow down the macro and it
> works. It just isn't very clean.
>
> As for parsing the attachment file - is that using the right function and
> taking the last 3 letters of the file? Thank you so much for your help.
>
> "Sue Mosher [MVP]" wrote:
>
>> 1) Rather than force us to read through all your code, could you explain
>> what job the macro is supposed to accomplish?
>>
>> 2) Parse the attachment file name to extract the extension then use a
>> series
>> of If ... Then ... ElseIf statements or, better, a Select Case block.
>> --
>> Sue Mosher, Outlook MVP
>> Author of Microsoft Outlook 2007 Programming:
>> Jumpstart for Power Users and Administrators
>> http://www.outlookcode.com/article.aspx?id=54
>>
>>
>> "hlock" <(E-Mail Removed)> wrote in message
>> news:4556BBA2-1984-441D-B244-(E-Mail Removed)...
>> >I have 2 questions. The first one is 1) My macro does the job, but it
>> >really
>> > seems to repeat itself. Is there a better way of writing it? My
>> > second
>> > question is 2) we originally were just looking to identify .msg
>> > attachments.
>> > Now however, we want to identify and separately process several other
>> > types
>> > of attachments (.htm, .zip). I'm not very knowlegeable in vba. What
>> > is
>> > the
>> > cleanest way to go from working with one extension to working with
>> > several?
>> > I appreciate your help.
>> >
>> > Public Sub StripAttachments()
>> > Dim objApp As Outlook.Application
>> > Dim ns As Outlook.NameSpace
>> > Dim Item As Object
>> > Dim objAttachments As Outlook.attachments
>> > Dim i As Long
>> > Dim lngCount As Long
>> > Dim strfile As String
>> > Dim tempfile As String
>> > Dim tempdir As String
>> > Dim del As String ' ttimport delete parameter
>> > Dim app As String ' ttimport application parameter
>> > Dim result
>> > Dim fso
>> > Dim fil
>> > Dim ext As String
>> > Dim strsubject As String
>> > Dim FileName As String
>> > Dim path As String
>> > Dim Response As VbMsgBoxResult
>> >
>> > On Error Resume Next
>> >
>> > Set fso = CreateObject("Scripting.filesystemobject")
>> > Set ns = GetNamespace("MAPI")
>> > ' Instantiate an Outlook Application object.
>> > Set objApp = CreateObject("Outlook.Application")
>> > Set objApp = Application
>> >
>> > ' Get the collection of selected objects.
>> > Select Case TypeName(objApp.ActiveWindow)
>> > Case "Explorer"
>> > Set Item = objApp.ActiveExplorer.Selection.Item(1)
>> > Case "Inspector"
>> > Set Item = objApp.ActiveInspector.CurrentItem
>> > Case Else
>> > '
>> > End Select
>> >
>> > 'Call SaveEmailNoAtt
>> > app = "/a=clmdoc"
>> >
>> > Set objAttachments = Item.attachments
>> > lngCount = objAttachments.Count
>> > If lngCount > 0 Then
>> > For i = lngCount To 1 Step -1
>> > strfile = objAttachments.Item(i).FileName
>> > If Right(strfile, 3) = "msg" Then
>> > If (FileExists("C:\Program Files\RLI\MSGImport.txt"))
>> > Then
>> > MsgBox "This email contains attachments that are
>> > emails." &
>> > vbCrLf & "Please process these attachments separately.", vbOKOnly +
>> > vbExclamation
>> > Else
>> > Response = MsgBox("This email requires special
>> > handling and must be processed by ClaimHelp." & vbCrLf & "Do you wish
>> > to
>> > forward to ClaimHelp now?", vbYesNo + vbExclamation)
>> > If Response = vbYes Then
>> > ForwardEmail
>> > 'MsgBox "This email requires special handling,
>> > please forward it to ClaimHelp for processing.", vbOKOnly +
>> > vbExclamation
>> > Else
>> > End If
>> > Exit Sub
>> > End If
>> > End If
>> > Next i
>> > End If
>> >
>> > ' Get the Temp folder.
>> > tempdir = ("c:\temp\outlookimport\")
>> > CheckFolder
>> >
>> > strsubject = Item.Subject
>> > FileName = StripIllegalChar(strsubject)
>> > FileName = Replace(FileName, " ", "_")
>> > If FileName = "" Then
>> > FileName = "No Subject"
>> > End If
>> >
>> > If fso.GetExtensionName(FileName) = "" Then
>> > FileName = FileName & ".rtf"
>> > End If
>> >
>> > ext = fso.GetExtensionName(FileName)
>> > path = fso.BuildPath(tempdir, FileName)
>> >
>> > Do While fso.FileExists(path)
>> > tempfile = fso.GetTempName
>> > tempfile = fso.GetBaseName(tempfile) & "." & ext
>> > path = fso.BuildPath(tempdir, tempfile)
>> > Loop
>> >
>> > Item.SaveAs path, olRTF
>> >
>> >
>> > Set fil = fso.GetFile(path)
>> > path = fil.ShortPath
>> > Set fil = Nothing
>> >
>> > ExecCmd "ttimport.exe " & app & " " & path
>> > Kill (path)
>> >
>> > ' Get the Attachments collection of the item.
>> > If lngCount > 0 Then
>> > ' We need to use a count down loop for
>> > ' removing items from a collection. Otherwise,
>> > ' the loop counter gets confused and only every
>> > ' other item is removed.
>> > For i = lngCount To 1 Step -1
>> > ' Get the file name.
>> > strfile = objAttachments.Item(i).FileName
>> > If Right(strfile, 3) <> "msg" Then
>> > strfile = Replace(strfile, " ", "_")
>> > 'Combine with the path to the Temp folder.
>> > strfile = tempdir & strfile
>> > ' Save the attachment as a file.
>> > objAttachments.Item(i).SaveAsFile strfile
>> > ExecCmd "ttimport.exe " & app & " " & strfile
>> > Kill (strfile)
>> > End If
>> > Next i
>> > End If
>> > 'Item.Save
>> >
>> > If lngCount > 0 Then
>> > For i = lngCount To 1 Step -1
>> > strfile = objAttachments.Item(i).FileName
>> > If Right(strfile, 3) = "msg" Then
>> > MsgBox "Email and attachments Saved Individually." &
>> > vbCrLf
>> > & "Please verify your documents imported correctly." & vbCrLf &
>> > "Remember
>> > to
>> > process the attached email separately!", vbOKOnly + vbExclamation
>> > Exit Sub
>> > Else
>> > MsgBox "Email and attachments Saved Individually." &
>> > vbCrLf
>> > & "Please verify your documents imported correctly.", vbOKOnly
>> > Exit Sub
>> > End If
>> > Next i
>> > End If
>> > ExitSub:
>> > Set objAttachments = Nothing
>> > Set Item = Nothing
>> > Set objApp = Nothing
>> >
>> > 'MsgBox "Email and attachments Saved Individually. Please verify your
>> > documents imported correctly."
>> >
>> > End Sub
>> >
>>
>>
>> .
>>

Thank you. It's just that I don't know how I would consolidate the
operations into one loop. That's why I ended up with three separate loops.
Do you have any suggestions? I would appreciate any help you might provide.

"Sue Mosher [MVP]" wrote:

> I agree that it's inefficient to handle each attachment 3 times. You should
> consolidate your operations into one loop.
>
> Most file extensions are 3 characters, so you can use Right() and succeed
> most of the time. An even more certain approach would be to use the
> InStrRev() function to locate the rightmost period in the file name and then
> use Mid() to extract all characters to the right of the period.
> --
> Sue Mosher, Outlook MVP
> Author of Microsoft Outlook 2007 Programming:
> Jumpstart for Power Users and Administrators
> http://www.outlookcode.com/article.aspx?id=54
>
>
> "hlock" <(E-Mail Removed)> wrote in message
> news:4D722AAE-554B-4CE5-AA03-(E-Mail Removed)...
> > Sure - using our document repository executable, the macro saves the email
> > by
> > itself as an rtf to our document repository, then it saves each attachment
> > to
> > our document repository. The macro runs through the attachments 3x to
> > look
> > at the attachments:
> >
> > 1. The macro looks at each attachment. If there is a .msg attachment and
> > the user has a particular file on their computer, they get a message, but
> > the
> > macro continues. If the user does not have the file on their computer,
> > the
> > macro ends.
> > 2. The macro processes each attachment, except any attachment that is a
> > .msg, and imports it to our document repository.
> > 3. The macro looks at each attachment. If there is a .msg attachment, it
> > reminds the user to import the .msg attachment separately. If there isn't
> > any .msg attachments, it just reminds the user to check the imports.
> >
> > I guess it's the running through of the attachments 3 different times that
> > seems redundant. However, it doesn't seem to slow down the macro and it
> > works. It just isn't very clean.
> >
> > As for parsing the attachment file - is that using the right function and
> > taking the last 3 letters of the file? Thank you so much for your help.
> >
> > "Sue Mosher [MVP]" wrote:
> >
> >> 1) Rather than force us to read through all your code, could you explain
> >> what job the macro is supposed to accomplish?
> >>
> >> 2) Parse the attachment file name to extract the extension then use a
> >> series
> >> of If ... Then ... ElseIf statements or, better, a Select Case block.
> >> --
> >> Sue Mosher, Outlook MVP
> >> Author of Microsoft Outlook 2007 Programming:
> >> Jumpstart for Power Users and Administrators
> >> http://www.outlookcode.com/article.aspx?id=54
> >>
> >>
> >> "hlock" <(E-Mail Removed)> wrote in message
> >> news:4556BBA2-1984-441D-B244-(E-Mail Removed)...
> >> >I have 2 questions. The first one is 1) My macro does the job, but it
> >> >really
> >> > seems to repeat itself. Is there a better way of writing it? My
> >> > second
> >> > question is 2) we originally were just looking to identify .msg
> >> > attachments.
> >> > Now however, we want to identify and separately process several other
> >> > types
> >> > of attachments (.htm, .zip). I'm not very knowlegeable in vba. What
> >> > is
> >> > the
> >> > cleanest way to go from working with one extension to working with
> >> > several?
> >> > I appreciate your help.
> >> >
> >> > Public Sub StripAttachments()
> >> > Dim objApp As Outlook.Application
> >> > Dim ns As Outlook.NameSpace
> >> > Dim Item As Object
> >> > Dim objAttachments As Outlook.attachments
> >> > Dim i As Long
> >> > Dim lngCount As Long
> >> > Dim strfile As String
> >> > Dim tempfile As String
> >> > Dim tempdir As String
> >> > Dim del As String ' ttimport delete parameter
> >> > Dim app As String ' ttimport application parameter
> >> > Dim result
> >> > Dim fso
> >> > Dim fil
> >> > Dim ext As String
> >> > Dim strsubject As String
> >> > Dim FileName As String
> >> > Dim path As String
> >> > Dim Response As VbMsgBoxResult
> >> >
> >> > On Error Resume Next
> >> >
> >> > Set fso = CreateObject("Scripting.filesystemobject")
> >> > Set ns = GetNamespace("MAPI")
> >> > ' Instantiate an Outlook Application object.
> >> > Set objApp = CreateObject("Outlook.Application")
> >> > Set objApp = Application
> >> >
> >> > ' Get the collection of selected objects.
> >> > Select Case TypeName(objApp.ActiveWindow)
> >> > Case "Explorer"
> >> > Set Item = objApp.ActiveExplorer.Selection.Item(1)
> >> > Case "Inspector"
> >> > Set Item = objApp.ActiveInspector.CurrentItem
> >> > Case Else
> >> > '
> >> > End Select
> >> >
> >> > 'Call SaveEmailNoAtt
> >> > app = "/a=clmdoc"
> >> >
> >> > Set objAttachments = Item.attachments
> >> > lngCount = objAttachments.Count
> >> > If lngCount > 0 Then
> >> > For i = lngCount To 1 Step -1
> >> > strfile = objAttachments.Item(i).FileName
> >> > If Right(strfile, 3) = "msg" Then
> >> > If (FileExists("C:\Program Files\RLI\MSGImport.txt"))
> >> > Then
> >> > MsgBox "This email contains attachments that are
> >> > emails." &
> >> > vbCrLf & "Please process these attachments separately.", vbOKOnly +
> >> > vbExclamation
> >> > Else
> >> > Response = MsgBox("This email requires special
> >> > handling and must be processed by ClaimHelp." & vbCrLf & "Do you wish
> >> > to
> >> > forward to ClaimHelp now?", vbYesNo + vbExclamation)
> >> > If Response = vbYes Then
> >> > ForwardEmail
> >> > 'MsgBox "This email requires special handling,
> >> > please forward it to ClaimHelp for processing.", vbOKOnly +
> >> > vbExclamation
> >> > Else
> >> > End If
> >> > Exit Sub
> >> > End If
> >> > End If
> >> > Next i
> >> > End If
> >> >
> >> > ' Get the Temp folder.
> >> > tempdir = ("c:\temp\outlookimport\")
> >> > CheckFolder
> >> >
> >> > strsubject = Item.Subject
> >> > FileName = StripIllegalChar(strsubject)
> >> > FileName = Replace(FileName, " ", "_")
> >> > If FileName = "" Then
> >> > FileName = "No Subject"
> >> > End If
> >> >
> >> > If fso.GetExtensionName(FileName) = "" Then
> >> > FileName = FileName & ".rtf"
> >> > End If
> >> >
> >> > ext = fso.GetExtensionName(FileName)
> >> > path = fso.BuildPath(tempdir, FileName)
> >> >
> >> > Do While fso.FileExists(path)
> >> > tempfile = fso.GetTempName
> >> > tempfile = fso.GetBaseName(tempfile) & "." & ext
> >> > path = fso.BuildPath(tempdir, tempfile)
> >> > Loop
> >> >
> >> > Item.SaveAs path, olRTF
> >> >
> >> >
> >> > Set fil = fso.GetFile(path)
> >> > path = fil.ShortPath
> >> > Set fil = Nothing
> >> >
> >> > ExecCmd "ttimport.exe " & app & " " & path
> >> > Kill (path)
> >> >
> >> > ' Get the Attachments collection of the item.
> >> > If lngCount > 0 Then
> >> > ' We need to use a count down loop for
> >> > ' removing items from a collection. Otherwise,
> >> > ' the loop counter gets confused and only every
> >> > ' other item is removed.
> >> > For i = lngCount To 1 Step -1
> >> > ' Get the file name.
> >> > strfile = objAttachments.Item(i).FileName
> >> > If Right(strfile, 3) <> "msg" Then
> >> > strfile = Replace(strfile, " ", "_")
> >> > 'Combine with the path to the Temp folder.
> >> > strfile = tempdir & strfile
> >> > ' Save the attachment as a file.
> >> > objAttachments.Item(i).SaveAsFile strfile
> >> > ExecCmd "ttimport.exe " & app & " " & strfile
> >> > Kill (strfile)
> >> > End If
> >> > Next i
> >> > End If
> >> > 'Item.Save
> >> >
> >> > If lngCount > 0 Then
> >> > For i = lngCount To 1 Step -1
> >> > strfile = objAttachments.Item(i).FileName
> >> > If Right(strfile, 3) = "msg" Then
> >> > MsgBox "Email and attachments Saved Individually." &
> >> > vbCrLf
> >> > & "Please verify your documents imported correctly." & vbCrLf &
> >> > "Remember
> >> > to
> >> > process the attached email separately!", vbOKOnly + vbExclamation
> >> > Exit Sub
> >> > Else
> >> > MsgBox "Email and attachments Saved Individually." &
> >> > vbCrLf
> >> > & "Please verify your documents imported correctly.", vbOKOnly
> >> > Exit Sub
> >> > End If
> >> > Next i
> >> > End If
> >> > ExitSub:
> >> > Set objAttachments = Nothing
> >> > Set Item = Nothing
> >> > Set objApp = Nothing
> >> >
> >> > 'MsgBox "Email and attachments Saved Individually. Please verify your
> >> > documents imported correctly."
> >> >
> >> > End Sub
> >> >
> >>
> >>
> >> .
> >>
>
>
> .
>

I would suggest that you analyze each loop for what it does and write it out
in "pseudocode" -- i.e. focusing on the operations and decision points, as
in a flow chart, without worrying about the actual code syntax. If you do
that, you should see where you can consolidate.
--
Sue Mosher, Outlook MVP
Author of Microsoft Outlook 2007 Programming:
Jumpstart for Power Users and Administrators
http://www.outlookcode.com/article.aspx?id=54


"hlock" <(E-Mail Removed)> wrote in message
news5382E6A-629A-453E-B8D2-(E-Mail Removed)...
> Thank you. It's just that I don't know how I would consolidate the
> operations into one loop. That's why I ended up with three separate
> loops.
> Do you have any suggestions? I would appreciate any help you might
> provide.
>
> "Sue Mosher [MVP]" wrote:
>
>> I agree that it's inefficient to handle each attachment 3 times. You
>> should
>> consolidate your operations into one loop.
>>
>> Most file extensions are 3 characters, so you can use Right() and succeed
>> most of the time. An even more certain approach would be to use the
>> InStrRev() function to locate the rightmost period in the file name and
>> then
>> use Mid() to extract all characters to the right of the period.
>>
>> "hlock" <(E-Mail Removed)> wrote in message
>> news:4D722AAE-554B-4CE5-AA03-(E-Mail Removed)...
>> > Sure - using our document repository executable, the macro saves the
>> > email
>> > by
>> > itself as an rtf to our document repository, then it saves each
>> > attachment
>> > to
>> > our document repository. The macro runs through the attachments 3x to
>> > look
>> > at the attachments:
>> >
>> > 1. The macro looks at each attachment. If there is a .msg attachment
>> > and
>> > the user has a particular file on their computer, they get a message,
>> > but
>> > the
>> > macro continues. If the user does not have the file on their computer,
>> > the
>> > macro ends.
>> > 2. The macro processes each attachment, except any attachment that is
>> > a
>> > .msg, and imports it to our document repository.
>> > 3. The macro looks at each attachment. If there is a .msg attachment,
>> > it
>> > reminds the user to import the .msg attachment separately. If there
>> > isn't
>> > any .msg attachments, it just reminds the user to check the imports.
>> >
>> > I guess it's the running through of the attachments 3 different times
>> > that
>> > seems redundant. However, it doesn't seem to slow down the macro and
>> > it
>> > works. It just isn't very clean.
>> >
>> > As for parsing the attachment file - is that using the right function
>> > and
>> > taking the last 3 letters of the file? Thank you so much for your
>> > help.
>> >
>> > "Sue Mosher [MVP]" wrote:
>> >
>> >> 1) Rather than force us to read through all your code, could you
>> >> explain
>> >> what job the macro is supposed to accomplish?
>> >>
>> >> 2) Parse the attachment file name to extract the extension then use a
>> >> series
>> >> of If ... Then ... ElseIf statements or, better, a Select Case block.
>> >> --
>> >> Sue Mosher, Outlook MVP
>> >> Author of Microsoft Outlook 2007 Programming:
>> >> Jumpstart for Power Users and Administrators
>> >> http://www.outlookcode.com/article.aspx?id=54
>> >>
>> >>
>> >> "hlock" <(E-Mail Removed)> wrote in message
>> >> news:4556BBA2-1984-441D-B244-(E-Mail Removed)...
>> >> >I have 2 questions. The first one is 1) My macro does the job, but
>> >> >it
>> >> >really
>> >> > seems to repeat itself. Is there a better way of writing it? My
>> >> > second
>> >> > question is 2) we originally were just looking to identify .msg
>> >> > attachments.
>> >> > Now however, we want to identify and separately process several
>> >> > other
>> >> > types
>> >> > of attachments (.htm, .zip). I'm not very knowlegeable in vba.
>> >> > What
>> >> > is
>> >> > the
>> >> > cleanest way to go from working with one extension to working with
>> >> > several?
>> >> > I appreciate your help.
>> >> >
>> >> > Public Sub StripAttachments()
>> >> > Dim objApp As Outlook.Application
>> >> > Dim ns As Outlook.NameSpace
>> >> > Dim Item As Object
>> >> > Dim objAttachments As Outlook.attachments
>> >> > Dim i As Long
>> >> > Dim lngCount As Long
>> >> > Dim strfile As String
>> >> > Dim tempfile As String
>> >> > Dim tempdir As String
>> >> > Dim del As String ' ttimport delete parameter
>> >> > Dim app As String ' ttimport application parameter
>> >> > Dim result
>> >> > Dim fso
>> >> > Dim fil
>> >> > Dim ext As String
>> >> > Dim strsubject As String
>> >> > Dim FileName As String
>> >> > Dim path As String
>> >> > Dim Response As VbMsgBoxResult
>> >> >
>> >> > On Error Resume Next
>> >> >
>> >> > Set fso = CreateObject("Scripting.filesystemobject")
>> >> > Set ns = GetNamespace("MAPI")
>> >> > ' Instantiate an Outlook Application object.
>> >> > Set objApp = CreateObject("Outlook.Application")
>> >> > Set objApp = Application
>> >> >
>> >> > ' Get the collection of selected objects.
>> >> > Select Case TypeName(objApp.ActiveWindow)
>> >> > Case "Explorer"
>> >> > Set Item = objApp.ActiveExplorer.Selection.Item(1)
>> >> > Case "Inspector"
>> >> > Set Item = objApp.ActiveInspector.CurrentItem
>> >> > Case Else
>> >> > '
>> >> > End Select
>> >> >
>> >> > 'Call SaveEmailNoAtt
>> >> > app = "/a=clmdoc"
>> >> >
>> >> > Set objAttachments = Item.attachments
>> >> > lngCount = objAttachments.Count
>> >> > If lngCount > 0 Then
>> >> > For i = lngCount To 1 Step -1
>> >> > strfile = objAttachments.Item(i).FileName
>> >> > If Right(strfile, 3) = "msg" Then
>> >> > If (FileExists("C:\Program Files\RLI\MSGImport.txt"))
>> >> > Then
>> >> > MsgBox "This email contains attachments that are
>> >> > emails." &
>> >> > vbCrLf & "Please process these attachments separately.", vbOKOnly +
>> >> > vbExclamation
>> >> > Else
>> >> > Response = MsgBox("This email requires
>> >> > special
>> >> > handling and must be processed by ClaimHelp." & vbCrLf & "Do you
>> >> > wish
>> >> > to
>> >> > forward to ClaimHelp now?", vbYesNo + vbExclamation)
>> >> > If Response = vbYes Then
>> >> > ForwardEmail
>> >> > 'MsgBox "This email requires special
>> >> > handling,
>> >> > please forward it to ClaimHelp for processing.", vbOKOnly +
>> >> > vbExclamation
>> >> > Else
>> >> > End If
>> >> > Exit Sub
>> >> > End If
>> >> > End If
>> >> > Next i
>> >> > End If
>> >> >
>> >> > ' Get the Temp folder.
>> >> > tempdir = ("c:\temp\outlookimport\")
>> >> > CheckFolder
>> >> >
>> >> > strsubject = Item.Subject
>> >> > FileName = StripIllegalChar(strsubject)
>> >> > FileName = Replace(FileName, " ", "_")
>> >> > If FileName = "" Then
>> >> > FileName = "No Subject"
>> >> > End If
>> >> >
>> >> > If fso.GetExtensionName(FileName) = "" Then
>> >> > FileName = FileName & ".rtf"
>> >> > End If
>> >> >
>> >> > ext = fso.GetExtensionName(FileName)
>> >> > path = fso.BuildPath(tempdir, FileName)
>> >> >
>> >> > Do While fso.FileExists(path)
>> >> > tempfile = fso.GetTempName
>> >> > tempfile = fso.GetBaseName(tempfile) & "." & ext
>> >> > path = fso.BuildPath(tempdir, tempfile)
>> >> > Loop
>> >> >
>> >> > Item.SaveAs path, olRTF
>> >> >
>> >> >
>> >> > Set fil = fso.GetFile(path)
>> >> > path = fil.ShortPath
>> >> > Set fil = Nothing
>> >> >
>> >> > ExecCmd "ttimport.exe " & app & " " & path
>> >> > Kill (path)
>> >> >
>> >> > ' Get the Attachments collection of the item.
>> >> > If lngCount > 0 Then
>> >> > ' We need to use a count down loop for
>> >> > ' removing items from a collection. Otherwise,
>> >> > ' the loop counter gets confused and only every
>> >> > ' other item is removed.
>> >> > For i = lngCount To 1 Step -1
>> >> > ' Get the file name.
>> >> > strfile = objAttachments.Item(i).FileName
>> >> > If Right(strfile, 3) <> "msg" Then
>> >> > strfile = Replace(strfile, " ", "_")
>> >> > 'Combine with the path to the Temp folder.
>> >> > strfile = tempdir & strfile
>> >> > ' Save the attachment as a file.
>> >> > objAttachments.Item(i).SaveAsFile strfile
>> >> > ExecCmd "ttimport.exe " & app & " " & strfile
>> >> > Kill (strfile)
>> >> > End If
>> >> > Next i
>> >> > End If
>> >> > 'Item.Save
>> >> >
>> >> > If lngCount > 0 Then
>> >> > For i = lngCount To 1 Step -1
>> >> > strfile = objAttachments.Item(i).FileName
>> >> > If Right(strfile, 3) = "msg" Then
>> >> > MsgBox "Email and attachments Saved Individually." &
>> >> > vbCrLf
>> >> > & "Please verify your documents imported correctly." & vbCrLf &
>> >> > "Remember
>> >> > to
>> >> > process the attached email separately!", vbOKOnly + vbExclamation
>> >> > Exit Sub
>> >> > Else
>> >> > MsgBox "Email and attachments Saved Individually." &
>> >> > vbCrLf
>> >> > & "Please verify your documents imported correctly.", vbOKOnly
>> >> > Exit Sub
>> >> > End If
>> >> > Next i
>> >> > End If
>> >> > ExitSub:
>> >> > Set objAttachments = Nothing
>> >> > Set Item = Nothing
>> >> > Set objApp = Nothing
>> >> >
>> >> > 'MsgBox "Email and attachments Saved Individually. Please verify
>> >> > your
>> >> > documents imported correctly."
>> >> >
>> >> > End Sub