F
fee
I have an excel sheet which part of it checks my inbox for e mails with
the subject of "manual handling questionnaire" it then moves it to a
folder called manual, and then it is supposed to save the file in my h
drive, but it all works except that it will not save the file into my h
drive, the code is as follows:-
Sub SaveAttachments()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim olMi As MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim i As Long
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set MoveToFldr = Fldr.Folders("Manual")
MyPath = "H:\My Documents"
For i = Fldr.Items.Count To 1 Step -1
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "Manual Handling Questionnaire") > 0
Then
For Each olAtt In olMi.Attachments
If olAtt.Filename = "Manual Handling .xls" Then
olAtt.SaveAsFile MyPath & olMi.SenderName & ".xls"
End If
Next olAtt
olMi.Save
olMi.Move MoveToFldr
End If
Next i
Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Anyone know where I am going wrong and could you point me in the right
direction.
the subject of "manual handling questionnaire" it then moves it to a
folder called manual, and then it is supposed to save the file in my h
drive, but it all works except that it will not save the file into my h
drive, the code is as follows:-
Sub SaveAttachments()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim olMi As MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim i As Long
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set MoveToFldr = Fldr.Folders("Manual")
MyPath = "H:\My Documents"
For i = Fldr.Items.Count To 1 Step -1
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "Manual Handling Questionnaire") > 0
Then
For Each olAtt In olMi.Attachments
If olAtt.Filename = "Manual Handling .xls" Then
olAtt.SaveAsFile MyPath & olMi.SenderName & ".xls"
End If
Next olAtt
olMi.Save
olMi.Move MoveToFldr
End If
Next i
Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Anyone know where I am going wrong and could you point me in the right
direction.