R
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
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