hi
i have read the model guard tips on how to get around the model guard but
have come stuck on what i should do to change my coding to allow instant
access to my email account. my program looks at a secondary email account and
takes the attachments off them then moves them to a folder within the inbox.
im not at all knowledgable with programming out look and have pieced this
program together from little bits i have picked up on various sites. can
anyone help me re engineer this to bypass the dialogue box?

thank you before hand.

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim subfolder2 As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName, sel As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Dim orecip As Outlook.Recipient
Dim itemcheck As Boolean
Dim myitem As Object
Dim otherInbox As Outlook.MAPIFolder
Dim iCount As Long
Dim i1 As Long
Dim Items As Outlook.Items


Set ns = GetNamespace("MAPI")
Set orecip = ns.CreateRecipient("recieved")

If orecip.Resolve() Then
Set otherInbox = ns.GetSharedDefaultFolder(orecip, olFolderInbox)
Else
MsgBox "No Mailbox"
End If

Set subfolder2 = otherInbox.Folders("Processed")
'Set Items = SubFolder.Items
Set Items = otherInbox.Items
i = 0

If otherInbox.Items.Count = 0 Then
MsgBox "There are no messages contained in the Inbox.",
vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In otherInbox.Items
For Each Atmt In Item.Attachments
Dim count2 As Integer
count2 = Item.Attachments.Count
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "C:\Finance\" & Atmt.FileName
On Error Resume Next
Atmt.SaveAsFile FileName
SetAttr FileName, vbNormal


i = i + 1
End If
Next Atmt
Next Item

i1 = Items.Count
i1 = i1 + 1
Do Until i1 = 0


On Error Resume Next
Items(i1).Move otherInbox.Folders("Flash Processed")

i1 = i1 - 1
Loop

SaveAttachmentsToFolder_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

Resume SaveAttachmentsToFolder_exit

What Outlook version do you use, and where have you running the code?

--
Best regards
Michael Bauer - MVP Outlook

: VBOffice Reporter for Data Analysis & Reporting
: Outlook Categories? Category Manager Is Your Tool
: http://www.vboffice.net/product.html?pub=6&lang=en


Am Fri, 22 Aug 2008 16:56:00 -0700 schrieb Rivers:

hi
i have read the model guard tips on how to get around the model guard but
have come stuck on what i should do to change my coding to allow instant
access to my email account. my program looks at a secondary email account
and
takes the attachments off them then moves them to a folder within the
inbox.
im not at all knowledgable with programming out look and have pieced this
program together from little bits i have picked up on various sites. can
anyone help me re engineer this to bypass the dialogue box?

thank you before hand.

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim subfolder2 As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName, sel As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Dim orecip As Outlook.Recipient
Dim itemcheck As Boolean
Dim myitem As Object
Dim otherInbox As Outlook.MAPIFolder
Dim iCount As Long
Dim i1 As Long
Dim Items As Outlook.Items


Set ns = GetNamespace("MAPI")
Set orecip = ns.CreateRecipient("recieved")

If orecip.Resolve() Then
Set otherInbox = ns.GetSharedDefaultFolder(orecip,
olFolderInbox)
Else
MsgBox "No Mailbox"
End If

Set subfolder2 = otherInbox.Folders("Processed")
'Set Items = SubFolder.Items
Set Items = otherInbox.Items
i = 0

If otherInbox.Items.Count = 0 Then
MsgBox "There are no messages contained in the Inbox.",
vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In otherInbox.Items
For Each Atmt In Item.Attachments
Dim count2 As Integer
count2 = Item.Attachments.Count
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "C:\Finance\" & Atmt.FileName
On Error Resume Next
Atmt.SaveAsFile FileName
SetAttr FileName, vbNormal


i = i + 1
End If
Next Atmt
Next Item

i1 = Items.Count
i1 = i1 + 1
Do Until i1 = 0


On Error Resume Next
Items(i1).Move otherInbox.Folders("Flash Processed")

i1 = i1 - 1
Loop

SaveAttachmentsToFolder_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

Resume SaveAttachmentsToFolder_exit

hi michael im calling it from 2003 excel to open and run outlook 2003



"Michael Bauer [MVP - Outlook]" wrote:



What Outlook version do you use, and where have you running the code?

--
Best regards
Michael Bauer - MVP Outlook

: VBOffice Reporter for Data Analysis & Reporting
: Outlook Categories? Category Manager Is Your Tool
: http://www.vboffice.net/product.html?pub=6&lang=en


Am Fri, 22 Aug 2008 16:56:00 -0700 schrieb Rivers:

hi
i have read the model guard tips on how to get around the model guard but
have come stuck on what i should do to change my coding to allow instant
access to my email account. my program looks at a secondary email account
and
takes the attachments off them then moves them to a folder within the
inbox.
im not at all knowledgable with programming out look and have pieced this
program together from little bits i have picked up on various sites. can
anyone help me re engineer this to bypass the dialogue box?

thank you before hand.

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim subfolder2 As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName, sel As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Dim orecip As Outlook.Recipient
Dim itemcheck As Boolean
Dim myitem As Object
Dim otherInbox As Outlook.MAPIFolder
Dim iCount As Long
Dim i1 As Long
Dim Items As Outlook.Items


Set ns = GetNamespace("MAPI")
Set orecip = ns.CreateRecipient("recieved")

If orecip.Resolve() Then
Set otherInbox = ns.GetSharedDefaultFolder(orecip,
olFolderInbox)
Else
MsgBox "No Mailbox"
End If

Set subfolder2 = otherInbox.Folders("Processed")
'Set Items = SubFolder.Items
Set Items = otherInbox.Items
i = 0

If otherInbox.Items.Count = 0 Then
MsgBox "There are no messages contained in the Inbox.",
vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In otherInbox.Items
For Each Atmt In Item.Attachments
Dim count2 As Integer
count2 = Item.Attachments.Count
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "C:\Finance\" & Atmt.FileName
On Error Resume Next
Atmt.SaveAsFile FileName
SetAttr FileName, vbNormal


i = i + 1
End If
Next Atmt
Next Item

i1 = Items.Count
i1 = i1 + 1
Do Until i1 = 0


On Error Resume Next
Items(i1).Move otherInbox.Folders("Flash Processed")

i1 = i1 - 1
Loop

SaveAttachmentsToFolder_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

Resume SaveAttachmentsToFolder_exit

Please see whether you can run the code within Outlook because that wouldn't
raise the security prompt. Else, you might look at the Redemption
(www.dimastr.com)

--
Best regards
Michael Bauer - MVP Outlook

: VBOffice Reporter for Data Analysis & Reporting
: Outlook Categories? Category Manager Is Your Tool
: http://www.vboffice.net/product.html?pub=6&lang=en



Am Sun, 24 Aug 2008 14:12:01 -0700 schrieb Rivers:

hi michael im calling it from 2003 excel to open and run outlook 2003



"Michael Bauer [MVP - Outlook]" wrote:



What Outlook version do you use, and where have you running the code?

--
Best regards
Michael Bauer - MVP Outlook

: VBOffice Reporter for Data Analysis & Reporting
: Outlook Categories? Category Manager Is Your Tool
: http://www.vboffice.net/product.html?pub=6&lang=en


Am Fri, 22 Aug 2008 16:56:00 -0700 schrieb Rivers:

hi
i have read the model guard tips on how to get around the model guard
but
have come stuck on what i should do to change my coding to allow instant
access to my email account. my program looks at a secondary email
account
and
takes the attachments off them then moves them to a folder within the
inbox.
im not at all knowledgable with programming out look and have pieced
this
program together from little bits i have picked up on various sites. can
anyone help me re engineer this to bypass the dialogue box?

thank you before hand.

Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim SubFolder As MAPIFolder
Dim subfolder2 As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName, sel As String
Dim i As Integer
Dim varResponse As VbMsgBoxResult
Dim orecip As Outlook.Recipient
Dim itemcheck As Boolean
Dim myitem As Object
Dim otherInbox As Outlook.MAPIFolder
Dim iCount As Long
Dim i1 As Long
Dim Items As Outlook.Items


Set ns = GetNamespace("MAPI")
Set orecip = ns.CreateRecipient("recieved")

If orecip.Resolve() Then
Set otherInbox = ns.GetSharedDefaultFolder(orecip,
olFolderInbox)
Else
MsgBox "No Mailbox"
End If

Set subfolder2 = otherInbox.Folders("Processed")
'Set Items = SubFolder.Items
Set Items = otherInbox.Items
i = 0

If otherInbox.Items.Count = 0 Then
MsgBox "There are no messages contained in the Inbox.",
vbInformation, _
"Nothing Found"
Exit Sub
End If

For Each Item In otherInbox.Items
For Each Atmt In Item.Attachments
Dim count2 As Integer
count2 = Item.Attachments.Count
If Right(Atmt.FileName, 3) = "xls" Then
FileName = "C:\Finance\" & Atmt.FileName
On Error Resume Next
Atmt.SaveAsFile FileName
SetAttr FileName, vbNormal


i = i + 1
End If
Next Atmt
Next Item

i1 = Items.Count
i1 = i1 + 1
Do Until i1 = 0


On Error Resume Next
Items(i1).Move otherInbox.Folders("Flash Processed")

i1 = i1 - 1
Loop

SaveAttachmentsToFolder_exit:
Set Atmt = Nothing
Set Item = Nothing
Set ns = Nothing
Exit Sub

Resume SaveAttachmentsToFolder_exit