O
Osama Yahya
Hi there:
I have a macro in outlook that prints html attachment
using IE object model and I am getting ExecWB failed error
when I runs the macro, here is my code, any help is
appreciated.
On Error GoTo GetAttachments_err
Dim Inbox As MAPIFolder
Dim EZBUYSubInbox As MAPIFolder '**
Dim JunkSubInbox As MAPIFolder '**
Dim email As MailItem
Dim Atmt As Attachment
Dim i As Integer, Count As Integer
Const FileName = "C:\ATT\"
Set Inbox = GetNamespace("MAPI").GetDefaultFolder
(olFolderInbox)
Set EZBUYSubInbox = Inbox.Folders("EZBUY")
Set JunkSubInbox = Inbox.Folders("Junk")
Dim IE As New InternetExplorer
i = 0
If Inbox.Items.Count = 0 Then Exit Sub
'cycle through emails
For Each email In Inbox.Items
If email.UnRead Then '**
If email.Subject = "PCO" Then
If email.Attachments.Count > 0 Then
For Count = email.Attachments.Count To 1 Step -1
Set Atmt = email.Attachments.Item(Count)
'If LCase(Right(Atmt.FileName, 3)) = "wav" Or _
' LCase(Right(Atmt.FileName, 3)) = "xml" Then
Atmt.SaveAsFile (FileName & Atmt.FileName)
IE.Visible = False
IE.navigate FileName & Atmt.FileName
While IE.readyState = 4
DoEvents
Wend
Do Until IE.Busy <> False
DoEvents
Loop
IE.ExecWB 6, 2, 0, 0
If Not EZBUYSubInbox Is Nothing Then
' email.Move EZBUYSubInbox
End If
'Atmt.Delete
i = i + 1
'End If
Next Count
' email.Save
End If
Else
email.Move JunkSubInbox
End If
End If '**
Next email
If i > 0 Then
'MsgBox " " & i & " attached files were found." _
' & vbCrLf & "They have been copied to your work
folder." _
' & vbCrLf & vbCrLf & "Have a nice day.",
vbInformation, "Finished!"
End If
GetAttachments_exit:
Set Atmt = Nothing
Set email = Nothing
Set Inbox = Nothing
Set EZBUYSubInbox = Nothing
Set JunkSubInbox = Nothing
Set IE = Nothing
Exit Sub
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following
information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit
I have a macro in outlook that prints html attachment
using IE object model and I am getting ExecWB failed error
when I runs the macro, here is my code, any help is
appreciated.
On Error GoTo GetAttachments_err
Dim Inbox As MAPIFolder
Dim EZBUYSubInbox As MAPIFolder '**
Dim JunkSubInbox As MAPIFolder '**
Dim email As MailItem
Dim Atmt As Attachment
Dim i As Integer, Count As Integer
Const FileName = "C:\ATT\"
Set Inbox = GetNamespace("MAPI").GetDefaultFolder
(olFolderInbox)
Set EZBUYSubInbox = Inbox.Folders("EZBUY")
Set JunkSubInbox = Inbox.Folders("Junk")
Dim IE As New InternetExplorer
i = 0
If Inbox.Items.Count = 0 Then Exit Sub
'cycle through emails
For Each email In Inbox.Items
If email.UnRead Then '**
If email.Subject = "PCO" Then
If email.Attachments.Count > 0 Then
For Count = email.Attachments.Count To 1 Step -1
Set Atmt = email.Attachments.Item(Count)
'If LCase(Right(Atmt.FileName, 3)) = "wav" Or _
' LCase(Right(Atmt.FileName, 3)) = "xml" Then
Atmt.SaveAsFile (FileName & Atmt.FileName)
IE.Visible = False
IE.navigate FileName & Atmt.FileName
While IE.readyState = 4
DoEvents
Wend
Do Until IE.Busy <> False
DoEvents
Loop
IE.ExecWB 6, 2, 0, 0
If Not EZBUYSubInbox Is Nothing Then
' email.Move EZBUYSubInbox
End If
'Atmt.Delete
i = i + 1
'End If
Next Count
' email.Save
End If
Else
email.Move JunkSubInbox
End If
End If '**
Next email
If i > 0 Then
'MsgBox " " & i & " attached files were found." _
' & vbCrLf & "They have been copied to your work
folder." _
' & vbCrLf & vbCrLf & "Have a nice day.",
vbInformation, "Finished!"
End If
GetAttachments_exit:
Set Atmt = Nothing
Set email = Nothing
Set Inbox = Nothing
Set EZBUYSubInbox = Nothing
Set JunkSubInbox = Nothing
Set IE = Nothing
Exit Sub
GetAttachments_err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following
information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description: " & Err.Description _
, vbCritical, "Error!"
Resume GetAttachments_exit