Better way of writing Macro? Identify multiple types of attachmen

Status
Not open for further replies.
H

hlock

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
 
S

Sue Mosher [MVP]

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

"hlock" <hlock> wrote in message

news:4556BBA2-1984-441D-B244-0D3789F4BC60@microsoft.com...
> 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
>
 
H

hlock

Re: Better way of writing Macro? Identify multiple types of attac

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
> > >

> "hlock" <hlock> wrote in message
> news:4556BBA2-1984-441D-B244-0D3789F4BC60@microsoft.com...
> >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
> >


> .
>
 
S

Sue Mosher [MVP]

Re: Better way of writing Macro? Identify multiple types of attac

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

"hlock" <hlock> wrote in message

news:4D722AAE-554B-4CE5-AA03-FA79D8BAA8D7@microsoft.com...
> 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
> > >> >> >
>
>> "hlock" <hlock> wrote in message
> > news:4556BBA2-1984-441D-B244-0D3789F4BC60@microsoft.com...
> > >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
> > >

>

>
>> .
> >
 
H

hlock

Re: Better way of writing Macro? Identify multiple types of attac

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
> > >

> "hlock" <hlock> wrote in message
> news:4D722AAE-554B-4CE5-AA03-FA79D8BAA8D7@microsoft.com...
> > 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
> >> > >> > >> > >
> >
> >> "hlock" <hlock> wrote in message
> >> news:4556BBA2-1984-441D-B244-0D3789F4BC60@microsoft.com...
> >> >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
> >> >
> >
> >> .
> >>


> .
>
 
S

Sue Mosher [MVP]

Re: Better way of writing Macro? Identify multiple types of attac

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

"hlock" <hlock> wrote in message

news:D5382E6A-629A-453E-B8D2-94A1E1F23548@microsoft.com...
> 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" <hlock> wrote in message
> > news:4D722AAE-554B-4CE5-AA03-FA79D8BAA8D7@microsoft.com...
> > > 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
> > >> >> >> >> >> >> >
>> >
>> >> "hlock" <hlock> wrote in message
> > >> news:4556BBA2-1984-441D-B244-0D3789F4BC60@microsoft.com...
> > >> >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
 
Status
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
Ajey Outlook 2013 Better address book Outlook Wishlist 0
M Sorting "sent emails" is not logical. Is there a better way. Using Outlook 4
F Better funtionality for IMAP Outlook Wishlist 1
R writing "Instant Search" queries to find User-Defined fields Using Outlook 0
D Writing to BCM Database from VBA BCM (Business Contact Manager) 0
P writing to excel from outlook Outlook VBA and Custom Forms 3
L Help for writing an Outlook 2007 macro Outlook VBA and Custom Forms 7
N Help creating a VBA macro with conditional formatting to change the font color of all external emails to red Outlook VBA and Custom Forms 5
S Visual indicator of a certain property or to show a macro toggle Outlook VBA and Custom Forms 2
L Modifying VBA script to delay running macro Outlook VBA and Custom Forms 3
S Macro to extract and modify links from emails Outlook VBA and Custom Forms 3
M Replyall macro with template and auto insert receptens Outlook VBA and Custom Forms 1
L Macro to add Date & Time etc to "drag to save" e-mails Outlook VBA and Custom Forms 8
S Macro for Loop through outlook unread emails Outlook VBA and Custom Forms 2
Globalforester ItemAdd Macro - multiple emails Outlook VBA and Custom Forms 3
S Macro to extract email addresses of recipients in current drafted email and put into clipboard Outlook VBA and Custom Forms 2
witzker HowTo start a macro with an Button in OL contact form Outlook VBA and Custom Forms 12
witzker Macro to move @domain.xx of a Spammail to Blacklist in Outlook 2019 Outlook VBA and Custom Forms 7
S Macro for other actions - Outlook 2007 Outlook VBA and Custom Forms 23
C Macro to extract sender name & subject line of incoming emails to single txt file Outlook VBA and Custom Forms 3
L Macro/VBA to Reply All, with the original attachments Outlook VBA and Custom Forms 2
S Macro to move “Re:” & “FWD:” email recieved the shared inbox to a subfolder in outlook Outlook VBA and Custom Forms 0
S Outlook Macro to send auto acknowledge mail only to new mails received to a specific shared inbox Outlook VBA and Custom Forms 0
S Outlook Macro to move reply mail based on the key word in the subjectline Outlook VBA and Custom Forms 0
Eike Move mails via macro triggered by the click of a button? Outlook VBA and Custom Forms 0
S Macro or plug-in to see if specific person was included in this email Outlook VBA and Custom Forms 4
U Macro for reminders,tasks,calendar Outlook VBA and Custom Forms 4
V macro runs slower on startup than after Outlook VBA and Custom Forms 3
N Macro to move all recipients to CC while replying Outlook VBA and Custom Forms 0
A VBA macro for 15 second loop in send and received just for 1 specific mailbox Outlook VBA and Custom Forms 1
G VBA Macro Calendar Printing Assistant 4
R Help Revising VBA macro to delete email over different time span Outlook VBA and Custom Forms 0
M Outlook macro to automate search and forward process Outlook VBA and Custom Forms 6
R Macro Schedule every day in Outlook Using Outlook 0
L Moving emails with similar subject and find the timings between the emails using outlook VBA macro Outlook VBA and Custom Forms 1
Healy Consultants Macro to remove inside organization distribution list email address when reply to all recepients Outlook VBA and Custom Forms 0
geofferyh Cannot get Macro to SAVE more than one message attachment??? Outlook VBA and Custom Forms 5
N How can I increase/faster outlook VBA Macro Speed ? Using Outlook 2
4 Macro to set the category of Deleted Item? Outlook VBA and Custom Forms 2
D.Moore Folder view settings by VBA macro Outlook VBA and Custom Forms 57
A Outlook macro to create search folder with mail categories as criteria Outlook VBA and Custom Forms 3
Dave A Run macro on existing appointment when it changes Outlook VBA and Custom Forms 1
V Outlook Macro to show Flagged messages Outlook VBA and Custom Forms 2
O Run macro automatically at sending an email Using Outlook 11
R Retain Original Message When Forwarding With Macro Outlook VBA and Custom Forms 3
C Macro to add multiple recipients to message Outlook VBA and Custom Forms 3
B Reply and replyall macro is not working Outlook VBA and Custom Forms 1
O Macro - paste as plain text Outlook VBA and Custom Forms 2
J Help Please!!! Outlook 2016 - VBA Macro for replying with attachment in meeting invite Outlook VBA and Custom Forms 9
witzker Macro to set contact reminder to next day 9:00 Outlook VBA and Custom Forms 45

Similar threads

Top