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


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

>

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


> .
>
 
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
M Sorting "sent emails" is not logical. Is there a better way. Using Outlook 4
S Outlook 365 Can I change the possible range of highlighting colours when writing an Outlook email? Using Outlook 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
X Custom icon (not from Office 365) for a macro in Outlook Outlook VBA and Custom Forms 1
X Run macro automatically when a mail appears in the sent folder Using Outlook 5
mrrobski68 Issue with Find messages in a conversation macro Outlook VBA and Custom Forms 1
G Creating Macro to scrape emails from calendar invite body Outlook VBA and Custom Forms 6
M Use Macro to change account settings Outlook VBA and Custom Forms 0
J Macro to Reply to Emails w/ Template Outlook VBA and Custom Forms 3
C Outlook - Macro to block senders domain - Macro Fix Outlook VBA and Custom Forms 1
Witzker Outlook 2019 Macro to seach in all contact Folders for marked Email Adress Outlook VBA and Custom Forms 1
S macro error 4605 Outlook VBA and Custom Forms 0
A Macro Mail Alert Using Outlook 4
J Outlook 365 Outlook Macro to Sort emails by column "Received" to view the latest email received Outlook VBA and Custom Forms 0
J Macro to send email as alias Outlook VBA and Custom Forms 0
M Outlook Macro to save as Email with a file name format : Date_Timestamp_Sender initial_Email subject Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro GoTo user defined search folder Outlook VBA and Custom Forms 6
D Outlook 2016 Creating an outlook Macro to select and approve Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro to send an Email Template from User Defined Contact Form Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro to check Cursor & Focus position Outlook VBA and Custom Forms 8
V Macro to mark email with a Category Outlook VBA and Custom Forms 4
M Outlook 2019 Macro not working Outlook VBA and Custom Forms 0
S Outlook 365 Help me create a Macro to make some received emails into tasks? Outlook VBA and Custom Forms 1
Geldner Send / Receive a particular group via macro or single keypress Using Outlook 1
D Auto Remove [EXTERNAL] from subject - Issue with Macro Using Outlook 21
V Macro to count flagged messages? Using Outlook 2
sophievldn Looking for a macro that moves completed items from subfolders to other subfolder Outlook VBA and Custom Forms 7
S Outlook Macro for [Date][Subject] Using Outlook 1
E Outlook - Macro - send list of Tasks which are not finished Outlook VBA and Custom Forms 3
E Macro to block senders domain Outlook VBA and Custom Forms 1
D VBA Macro to Print and Save email to network location Outlook VBA and Custom Forms 1
N VBA Macro To Save Emails Outlook VBA and Custom Forms 1
N Line to move origEmail to subfolder within a reply macro Outlook VBA and Custom Forms 0
Witzker Outlook 2019 Macro to answer a mail with attachments Outlook VBA and Custom Forms 2
A Outlook 2016 Macro to Reply, ReplyAll, or Forward(but with composing new email) Outlook VBA and Custom Forms 0
J Macro to Insert a Calendar Outlook VBA and Custom Forms 8
W Macro to Filter Based on Latest Email Outlook VBA and Custom Forms 6
T Macro to move reply and original message to folder Outlook VBA and Custom Forms 6
D Autosort macro for items in a view Outlook VBA and Custom Forms 2
S HTML to Plain Text Macro - Help Outlook VBA and Custom Forms 1
A Macro to file emails into subfolder based on subject line Outlook VBA and Custom Forms 1
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 17

Similar threads

Back
Top