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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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" wrote in message
news
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" wrote in message
...
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" wrote in message
...
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