That makes sense! Thanks Sue. Looks like you have to remove the existing
attachment first.
Here's my modified macro that will handle creating any supported Office
document type from an existing file:
Sub CreateOfficeDocInChosenFolder(lngDocType As OlOfficeDocItemsType)
On Error Resume Next
Dim objNS As Outlook.NameSpace
Dim objDoc As Outlook.DocumentItem
Dim objFolder As Outlook.MAPIFolder
Dim strFilePath As String, strExt As String, blnError As Boolean
Dim objFS As Scripting.FileSystemObject 'Need reference to Microsoft
Scripting Runtime
Set objNS = Application.GetNamespace("MAPI")
Set objFolder = objNS.PickFolder
If objFolder Is Nothing Then Exit Sub
strFilePath = InputBox("Please enter the location to your Office
document", "Enter File Path", "C:\Documents and
Settings\ericl\Desktop\Book1.xls")
Set objFS = New Scripting.FileSystemObject
If objFS.FileExists(strFilePath) = False Then
MsgBox "The file '" & strFilePath & "' is invalid.", vbOKOnly +
vbExclamation, "INVALID FILE"
Exit Sub
End If
strExt = Right(strFilePath, 3)
Select Case lngDocType
Case OlOfficeDocItemsType.olExcelWorkSheetItem
If strExt <> "xls" Then blnError = True
Case OlOfficeDocItemsType.olWordDocumentItem
If strExt <> "doc" Then blnError = True
Case OlOfficeDocItemsType.olPowerPointShowItem
If strExt <> "ppt" Then blnError = True
End Select
If blnError = True Then
MsgBox "Extension '" & strExt & "' does not match the
OlOfficeDocItemsType value.", vbOKOnly + vbExclamation, "INVALID FILE TYPE"
Exit Sub
End If
Set objDoc = objFolder.Items.Add(lngDocType)
objDoc.Attachments.Remove 1
objDoc.Attachments.Add strFilePath
objDoc.Subject = objDoc.Attachments.Item(1).DisplayName
objDoc.Save
Set objFS = Nothing
Set objDoc = Nothing
Set objFolder = Nothing
Set objNS = Nothing
End Sub