Fout 91 tijdens uitvoering

Status
Niet open voor verdere reacties.

Roland1973VBA

Nieuwe gebruiker
Lid geworden
28 feb 2020
Berichten
3
Hi all,

Ik heb een script gemaakt om een actie uit te voeren bij nieuwe mail in een shared mailbox in Outlook. Het script wordt wel gestart bij een nieuwe mail, maar ik krijg telkens een foutmelding en debug hangt dan op de regel: Set objMail = Outlook.Application.ActiveInspector.CurrentItem
De melding luidt:
Fout 91 tijdens uitvoering
Objectvariabele of blokvariabele With is niet ingesteld.

Kan iemand mij vertellen wat er fout gaat? Dit is het script

Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
' default local Inbox
Set Items = objNS.Folders("Shared mailbox").Folders("Postvak IN").Items

End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)

Dim objMail As Outlook.MailItem
Dim objAttachments As Outlook.Attachments
Dim objAttachment As Outlook.Attachment
Dim objShell As Object
Dim objFileSystem As Object
Dim strTempFolder As String
Dim strFilePath As String
Dim strFileName As String
Dim xMailItem As Outlook.MailItem
Dim Msg As Outlook.MailItem

Set objMail = Outlook.Application.ActiveInspector.CurrentItem
Set objAttachments = objMail.Attachments


'reserveringen voor nieuwe mail
Dim objMsg As MailItem

Set objMsg = Application.CreateItem(olMailItem)
Set objMsgAttachments = objMsg.Attachments
'eind reserveringen voor nieuwe mail

With objMsg
.To = "Mijn mailbox@hotmail.com"
.Subject = "This is the subject"
.BodyFormat = olFormatHTML
.HTMLBody = "Write your email here"


'Save & Unzip the zip file in local drive
Set objShell = CreateObject("Shell.Application")
Set objFileSystem = CreateObject("Scripting.FileSystemObject")
strTempFolder = objFileSystem.GetSpecialFolder(2).Path & "\Temp" & Format(Now, "yyyy-mm-dd-hh-mm-ss")
MkDir (strTempFolder)

For Each objAttachment In objAttachments
If Right(objAttachment.FileName, 3) = "zip" Then
strFilePath = strTempFolder & "\" & objAttachment.FileName
objAttachment.SaveAsFile (strFilePath)
objShell.NameSpace((strTempFolder)).CopyHere objShell.NameSpace((strFilePath)).Items
End If
Next

'Reattach the files extracted from the zip file
strFileName = Dir(strTempFolder & "\")

While Len(strFileName) > 0
objMail.Attachments.Add (strTempFolder & "\" & strFileName)
objMsg.Attachments.Add (strTempFolder & "\" & strFileName)
strFileName = Dir
objMail.Save
objMsg.Save
Wend

End With




'Delete the attachments in “.zip” file extension
Set objAttachments = objMail.Attachments
Set objMsgAttachments = objMsg.Attachments

For Each objAttachment In objAttachments
If Right(objAttachment.FileName, 3) = "zip" Then
objAttachment.Delete
objMail.Save
End If
Next


For Each objAttachment In objMsgAttachments
If Right(objAttachment.FileName, 3) = "zip" Then
objAttachment.Delete
objMail.Save
End If
Next
objMsg.Send

Set objMsg = Nothing
'Delete the temp folder and files
objFileSystem.DeleteFolder (strTempFolder)

End Sub
 
Kun je die meter code eerst eens in CODE tags zetten?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan