Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here


Outlook Attachment Types

Outlook Attachment Types

Outlook Attachment Types

Hi all:

I know OL isn't everyone's fave...mine either. I pieced together some nifty code (below) that takes the msgs from an OL2010 folder, saves it to the hard drive in whatever format the client wants, and then saves the attachments in a separate file.

From there, it logs all filenames in XL with hyperlinks to the files and msgs.

My problem is that during the attachment phase, it saves every .gif that might have been created for an RTF format of e-mail. It doesn't seem to do that in a text or HTML e-mail.

The only property I keep running in to is the class property, but when I debug, it just keeps giving me the same Type & Class of the object.

Any suggestions?


Private olNSpace As Outlook.NameSpace
Private MailInbox As Outlook.Folder
Private DestFolder As Outlook.Folder
Private MailItems As Outlook.Items
Private MailItm As Object
Private i As Integer
Private objFolder As Folder
Private strDate As String
Private strSub As String
Private winFldr As String
Private attFldr As String '= "\Attachments\"
Private eID As Long
Private StartPath As String
Private strSender As String
Private olFldrName As String
Private XL As Excel.Application

Private Sub ChooseFolder()

    Set olNSpace = Application.GetNamespace("MAPI")
    Set objFolder = olNSpace.PickFolder

    If TypeName(objFolder) <> "Nothing" Then
        LogFolder objFolder
        Debug.Print vbCr & "User pressed Cancel"
    End If

    Set objFolder = Nothing
    Set olNSpace = Nothing

End Sub

Private Sub LogFolder(ByVal olFolder As String)

Dim sFilePath As String
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim lngCount As Long
Dim j As Long
Dim attCount As Long

    ''Remove the hard coded path
    ''when you add a dialogue box to a form
    StartPath = "C:\EMails\"
    If Dir(StartPath) = "" Then
        sFilePath = CreateWinFolder(StartPath)
    End If
    Set olNSpace = Application.GetNamespace("MAPI")
    Set MailInbox = olNSpace.GetDefaultFolder(olFolderInbox)
    For i = 1 To MailInbox.Folders(olFolder).Items.Count
            If Dir(StartPath & olFolder & "\") = "" Then
                winFldr = CreateWinFolder(StartPath & olFolder & "\")
                attFldr = CreateWinFolder(winFldr & "\Attachments\")
                'Debug.Print winFldr & vbTab & attFldr
            End If
        eID = eID + 1

        Set DestFolder = MailInbox.Folders(olFolder)
        strSubject = ReplaceCharacters(DestFolder.Items(i), "-")
        strDate = GetStringDate(DestFolder.Items(i).SentOn)
        strSender = ReplaceCharacters(DestFolder.Items(i).SenderName, "-")
        ChDir winFldr
        If strSubject <> "" Then
            DestFolder.Items(i).SaveAs eID & " - " & Left(strSubject, 25) & ".rtf", olRTF
            DestFolder.Items(i).SaveAs eID & " - No Subject" & Left(strSubject, 25) & ".rtf", olRTF
        End If
        ''save attachments here
        ChDir attFldr
        SaveAttach DestFolder.Items(i), attFldr & "\"
        'Debug.Print DestFolder.Items(i), attFldr
    Next i

Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
Set olNSpace = Nothing
Set MailInbox = Nothing
End Sub

Private Sub SaveAttach(ByVal objMailItem As Outlook.MailItem, ByVal strPath As String)

Dim objAtt As Outlook.Attachment
Dim SaveFolder As String
Dim attID As Long
Dim fso As Object
Dim strOldName
Dim strFileName As String
Dim strNewFileName As String
Dim attType As OlAttachmentType
Dim instance As Attachment
Dim value As OlObjectClass

SaveFolder = strPath
ChDir SaveFolder

Set fso = CreateObject("Scripting.FileSystemObject")
'On Error Resume Next
    'If objMailItem.Attachments = 0 Then GoTo ReleaseObj
 'Attachment section    
 For Each objAtt In objMailItem.Attachments
    attType = objAtt.Type
    value = objAtt.Class
    attID = attID + 1
    Debug.Print eID & " - " & attID & " -  attType - " & attType & " - value - " & value
    strFileName = SaveFolder & objAtt.DisplayName
    objAtt.SaveAsFile strFileName
    Set strOldName = fso.GetFile(strFileName)
    strNewFileName = eID & "-" & attID & "-" & objAtt.DisplayName
    strOldName.Name = strNewFileName

    Set objAtt = Nothing
'to here 
'Exit Sub


''enter XL here
 Set objMailItem = Nothing
 Set fso = Nothing
  strFileName = ""
  strNewFileName = ""
  strOldName = ""
 End Sub 
I have a few other questions, too, but one at a time.

Any help will be greatly appreciated.

Ron Repp

If gray hair is a sign of wisdom, then I'm a genius.

My newest novel: Wooden Warriors http://www.repproductions.net

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close