Better way of writing Macro? Identify multiple types of attachmen

Discussion in 'Microsoft Outlook VBA Programming' started by hlock, Nov 30, 2009.

  1. hlock

    hlock Guest

    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
     
    hlock, Nov 30, 2009
    #1
    1. Advertisements

  2. 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
    news:...
    >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
    >
     
    Sue Mosher [MVP], Dec 1, 2009
    #2
    1. Advertisements

  3. hlock

    hlock Guest

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

    >
    >
    > .
    >
     
    hlock, Dec 1, 2009
    #3
  4. 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, 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:...
    > 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
    >> news:...
    >> >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
    >> >

    >>
    >>
    >> .
    >>
     
    Sue Mosher [MVP], Dec 1, 2009
    #4
  5. hlock

    hlock Guest

    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, 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:...
    > > 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
    > >> news:...
    > >> >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
    > >> >
    > >>
    > >>
    > >> .
    > >>

    >
    >
    > .
    >
     
    hlock, Dec 1, 2009
    #5
  6. 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, 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:D...
    > 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
    >> news:...
    >> > 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
    >> >> news:...
    >> >> >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
     
    Sue Mosher [MVP], Dec 1, 2009
    #6
    1. Advertisements

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Dmitry Streblechenko

    Re: There's gotta be a better way...

    Dmitry Streblechenko, Jun 30, 2003, in forum: Microsoft Outlook VBA Programming
    Replies:
    0
    Views:
    1,023
    Dmitry Streblechenko
    Jun 30, 2003
  2. Michael Bierman

    data corrections/updates in Outlook Contacts--must be a better way

    Michael Bierman, Apr 11, 2004, in forum: Microsoft Outlook VBA Programming
    Replies:
    2
    Views:
    171
    Michael Bierman
    Apr 12, 2004
  3. IanC

    Is there any way to identify original message text in "Item.Body"

    IanC, May 13, 2004, in forum: Microsoft Outlook VBA Programming
    Replies:
    1
    Views:
    297
    Sue Mosher [MVP-Outlook]
    May 13, 2004
  4. JP

    Re: Outlook Automation: is there a better way?

    JP, Jun 6, 2008, in forum: Microsoft Outlook VBA Programming
    Replies:
    3
    Views:
    378
    Dmitry Streblechenko
    Jun 6, 2008
  5. hirrsson

    How do I identify if it's a meeting request in this outlook macro?

    hirrsson, Jul 9, 2012, in forum: Microsoft Outlook VBA Programming
    Replies:
    1
    Views:
    978
    hirrsson
    Jul 10, 2012
Loading...

Share This Page