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