Hello All...
We are using Outlook 2002... I have code that de-attaches an attachment (see below) -- I now need to find out the email address (need the email address and not the name) the message was sent to in the same code of through another function call... Can anyone help?
Public Function SaveAttachments(Optional PathName As String) As Boolean
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As MAPIFolder
Dim oMessage As Object
Dim SpATHnAME As String
Dim oAttachment As Outlook.Attachment
Dim IcTR As Integer
Dim IaTTACHCNT As Integer
Dim objProcessedFolder As MAPIFolder
Dim rsltPost As Boolean
Dim filCheck As Boolean
On Error GoTo ErrHandler
If PathName = "" Then
SpATHnAME = GetTempDir
Else
SpATHnAME = PathName
End If
If Right(SpATHnAME, 1) <> "\" Then SpATHnAME = SpATHnAME & "\"
If Dir(SpATHnAME, vbDirectory) = "" Then Exit Function
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
Set objProcessedFolder = oFldr.Folders("Processed")
Dim test
For Each oMessage In oFldr.Items
If oMessage.UnRead Then
With oMessage.Attachments
IaTTACHCNT = .Count
If IaTTACHCNT > 0 Then
For IcTR = 1 To IaTTACHCNT
filCheck = filExists(.Item(IcTR).FileName)
If filCheck = False Then
.Item(IcTR).SaveAsFile SpATHnAME _
& .Item(IcTR).FileName
rsltPost = postAttach(.Item(IcTR).FileName, True, False, "")
Else
.Item(IcTR).SaveAsFile SpATHnAME _
& "DUP_" & .Item(IcTR).FileName
rsltPost = postAttach("DUP_" & .Item(IcTR).FileName, False, True, "Duplicate File Name")
End If
Next IcTR
End If
End With
DoEvents
oMessage.UnRead = False
'oMessage.Delete
'oMessage.Move objProcessedFolder
End If
Next
SaveAttachments = True
ErrHandler:
Set oMessage = Nothing
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Function
We are using Outlook 2002... I have code that de-attaches an attachment (see below) -- I now need to find out the email address (need the email address and not the name) the message was sent to in the same code of through another function call... Can anyone help?
Public Function SaveAttachments(Optional PathName As String) As Boolean
Dim oOutlook As Outlook.Application
Dim oNs As Outlook.NameSpace
Dim oFldr As MAPIFolder
Dim oMessage As Object
Dim SpATHnAME As String
Dim oAttachment As Outlook.Attachment
Dim IcTR As Integer
Dim IaTTACHCNT As Integer
Dim objProcessedFolder As MAPIFolder
Dim rsltPost As Boolean
Dim filCheck As Boolean
On Error GoTo ErrHandler
If PathName = "" Then
SpATHnAME = GetTempDir
Else
SpATHnAME = PathName
End If
If Right(SpATHnAME, 1) <> "\" Then SpATHnAME = SpATHnAME & "\"
If Dir(SpATHnAME, vbDirectory) = "" Then Exit Function
Set oOutlook = New Outlook.Application
Set oNs = oOutlook.GetNamespace("MAPI")
Set oFldr = oNs.GetDefaultFolder(olFolderInbox)
Set objProcessedFolder = oFldr.Folders("Processed")
Dim test
For Each oMessage In oFldr.Items
If oMessage.UnRead Then
With oMessage.Attachments
IaTTACHCNT = .Count
If IaTTACHCNT > 0 Then
For IcTR = 1 To IaTTACHCNT
filCheck = filExists(.Item(IcTR).FileName)
If filCheck = False Then
.Item(IcTR).SaveAsFile SpATHnAME _
& .Item(IcTR).FileName
rsltPost = postAttach(.Item(IcTR).FileName, True, False, "")
Else
.Item(IcTR).SaveAsFile SpATHnAME _
& "DUP_" & .Item(IcTR).FileName
rsltPost = postAttach("DUP_" & .Item(IcTR).FileName, False, True, "Duplicate File Name")
End If
Next IcTR
End If
End With
DoEvents
oMessage.UnRead = False
'oMessage.Delete
'oMessage.Move objProcessedFolder
End If
Next
SaveAttachments = True
ErrHandler:
Set oMessage = Nothing
Set oFldr = Nothing
Set oNs = Nothing
Set oOutlook = Nothing
End Function