Hi Guys
I have written following piece of code to save down attachments into pdf format on a shared drive but this code saves down logos/signatures in the email to the shared drive as well. I want to put a control that will ignore any invisible attachments and only the real attachments get save down .
ANy help will be much appreciated.
Thanks
I have written following piece of code to save down attachments into pdf format on a shared drive but this code saves down logos/signatures in the email to the shared drive as well. I want to put a control that will ignore any invisible attachments and only the real attachments get save down .
Code:
Private Sub SaveAttachments(olItem As Object)
Dim olAttach As Attachment
Dim strFName As String
Dim strExt As String
Dim j As Long
Dim olInsp As Inspector
Dim oRng As Object
Dim strTemp As String
Dim intPos As Integer
strTemp = Environ("TEMP") & "\"
If Not TypeName(olItem) = "MailItem" Then GoTo lbl_Exit
CreateFolders strSaveFldr
SaveAsPDFfile olItem
If olItem.Attachments.Count > 0 Then
For j = 1 To olItem.Attachments.Count
Set olAttach = olItem.Attachments(j)
Select Case LCase(Mid(olAttach.FileName, InStrRev(olAttach.FileName, Chr(46))))
Case ".docx", ".doc", ".txt"
On Error Resume Next
olAttach.SaveAsFile strTemp & olAttach.FileName
Set wdApp = GetObject(, "Word.Application")
If Err Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(strTemp & olAttach.FileName)
intPos = InStrRev(olAttach.FileName, ".")
strFName = Left(olAttach.FileName, intPos - 1)
strFName = strFName & ".pdf"
strExt = Right(strFName, Len(strFName) - InStrRev(strFName, Chr(46)))
strFName = FileNameUnique(strSaveFldr, strFName, strExt)
wdDoc.ExportAsFixedFormat OutputFilename:=strSaveFldr & strFName, _
ExportFormat:=17, _
OpenAfterExport:=False, _
OptimizeFor:=0, _
Range:=0, _
From:=0, _
To:=0, _
Item:=0, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=0, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=True
wdDoc.Close 0
wdApp.Quit
'If bWordWasNotRunning = True Then wdApp.Quit
Case ".pdf", ".jpg", ".jpeg"
strFName = olAttach.FileName
strExt = Right(strFName, Len(strFName) - InStrRev(strFName, Chr(46)))
strFName = FileNameUnique(strSaveFldr, strFName, strExt)
olAttach.SaveAsFile strSaveFldr & strFName
Case Else
MsgBox olAttach.FileName
End Select
olItem.Categories = ""
olItem.FlagStatus = olFlagComplete
olItem.UnRead = False
olItem.Save
Next j
olItem.Save
End If
lbl_Exit:
Set olAttach = Nothing
Set olItem = Nothing
Exit Sub
End Sub
ANy help will be much appreciated.
Thanks