• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 948
  • Last Modified:

Save Attachments of Outlook Message files Getting Zero byte files


I have a bunch of messages that were saved to files in a folder.  I would like to cycle through each message and save the attachments of each message to a folder.  The following code does just that except I get a zero byte file.  

What am I doing wrong?


Private Sub SaveAttachments()
Dim sFile As String
Dim msg As CDO.Message
'Dim oBodyPart As CDO.IBodyPart
Dim sPath As String
Dim sSavePath As String
Dim i As Integer
sPath = "C:\Roger\BundlePackage\"
sSavePath = "C:\Roger\BundlePackage\SavedAttachments\"
sFile = Dir(sPath & "*.msg")
Do While sFile <> ""
Set msg = LoadMessageFromFile(sPath & sFile)
With msg
If .Attachments.Count > 0 Then
    For i = 1 To .Attachments.Count
        Set oBodyPart = msg.Attachments(i)
        oBodyPart.SaveToFile sSavePath & oBodyPart.Filename
End If
End With
Set msg = Nothing
sFile = Dir
End Sub

' Reference to Microsoft ActiveX Data Objects 2.5 Library
' Reference to Microsoft CDO for Windows 2000 Library
Function LoadMessageFromFile(Path As String) As Message
    Dim Stm As New Stream
    Stm.LoadFromFile Path
    Dim iMsg As New CDO.Message
    Dim iDsrc As IDataSource
    Set iDsrc = iMsg
    iDsrc.OpenObject Stm, "_Stream"
    Set LoadMessageFromFile = iMsg
End Function
Rog D
Rog D
  • 3
  • 2
1 Solution
David WilhoitSenior Consultant, ExchangeCommented:
does the account you're running it under have send as/receive as perms on the store? I assume this is E2K

Rog DManager Inforamtion SystemsAuthor Commented:
Yes.  I am running Office XP on Exchange 5.5.  The messages are in file format located in a folder, so no connection to exchange server will be needed.

Rog DManager Inforamtion SystemsAuthor Commented:
Updated Points, really need answer....


David WilhoitSenior Consultant, ExchangeCommented:
Out of my league then. My bad, should have looked closer at your script....


Rog DManager Inforamtion SystemsAuthor Commented:
Here is a solution that will work, but it is not in CDO...

It utilized Outlook objects....

Dim myOlapp As Outlook.Application
    Dim myoMsg As Outlook.MailItem
    Set myOlapp = CreateObject("Outlook.Application")
    Set myoMsg = myOlapp.CreateItem(olMailItem)
    'sPath = "C:\Roger\BundlePackage\"
    sPath = "\\eve\tmpoll\3114\HSIA Data\"
    'sSavePath = "C:\Roger\BundlePackage\SavedAttachments\"
    sSavePath = "\\eve\tmpoll\3114\HSIA Data\SavedAttachments\"
    sFile = Dir(sPath & "*.msg")
    Do While sFile <> ""
        Set myoMsg = myOlapp.CreateItemFromTemplate(sPath & sFile)
        For i = 1 To myoMsg.Attachments.Count
            myoMsg.Attachments.Item(i).SaveAsFile sSavePath & myoMsg.Attachments(i).Filename
    sFile = Dir()
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Simplify Active Directory Administration

Administration of Active Directory does not have to be hard.  Too often what should be a simple task is made more difficult than it needs to be.The solution?  Hyena from SystemTools Software.  With ease-of-use as well as powerful importing and bulk updating capabilities.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now