VBA Disapperas

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,

I have a VBA that turn emails into tasks in Outlook XP, and for some reason
it disappears causing the subsequent rule to fail. It usually runs around 10
times, then the code simply goes away!

I have no idea to why this is occurring, and any help would be greatly
appreciated.
 
What do you mean by "it disappears"? Do you get an error?

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --

Am Thu, 23 Nov 2006 15:41:01 -0800 schrieb Nick_NZ:
 
Hi,

The rule fails and a message appears that outlook can not locate the code.
When I go into the VB editor the code is not there at all. This problem is
very weird as the code will just not be there for no apparent reason.
 
Can you enable VBA again via Help/About/Deactivated Items? Often that's
caused by VBA code that tries to instantiate a new Outlook Application
object, e.g. by CreateObject.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --


Am Sun, 26 Nov 2006 12:18:01 -0800 schrieb Nick_NZ:
 
Hi,

There is nothing in the disbaled items list. I can't find a deactivated
items, am I looking in the right place? Can you guys think of anything else,
I have been trying to solve this issue for about 2 months now! :(


Can you enable VBA again via Help/About/Deactivated Items? Often that's
caused by VBA code that tries to instantiate a new Outlook Application
object, e.g. by CreateObject.
 
Could you please show the code?

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --

Am Mon, 27 Nov 2006 11:35:01 -0800 schrieb Nick_NZ:
 
Here it is:

Sub MakeTaskFromMail(olMail As Outlook.MailItem)
Dim objTask As Outlook.TaskItem

Set objTask = Application.CreateItem(olTaskItem)
With objTask
.Subject = olMail.Subject
.DueDate = DateAddW(olMail.SentOn, 5)
.ReminderTime = DateAddW(olMail.SentOn, 4)
.Importance = olImportanceHigh
.Body = olMail.Body
End With

Call CopyAttachments(olMail, objTask)

olMail.Delete

objTask.Save

Set objTask = Nothing

End Sub

Sub CopyAttachments(objSourceItem, objTargetItem)
Set fso = CreateObject("Scripting.FileSystemObject")
Set fldTemp = fso.GetSpecialFolder(2) ' TemporaryFolder
strPath = fldTemp.Path & "\"
For Each objAtt In objSourceItem.Attachments
strFile = strPath & objAtt.FileName
objAtt.SaveAsFile strFile
objTargetItem.Attachments.Add strFile, , , objAtt.DisplayName
fso.DeleteFile strFile
Next

Set fldTemp = Nothing
Set fso = Nothing
End Sub

'========================================================================================================='
'The follwoing code was obtained from:
http://support.microsoft.com/default.aspx?scid=kb;en-us;198505
'========================================================================================================='

'========================================================'
' The DateAddW() function provides a workday substitute '
' for DateAdd("w", number, date). This function performs '
' error checking and ignores fractional Interval values. '
'========================================================'
Function DateAddW(ByVal TheDate, ByVal Interval)

Dim Weeks As Long, OddDays As Long, Temp As String

If VarType(TheDate) <> 7 Or VarType(Interval) < 2 Or _
VarType(Interval) > 5 Then
DateAddW = TheDate
ElseIf Interval = 0 Then
DateAddW = TheDate
ElseIf Interval > 0 Then
Interval = Int(Interval)

' Make sure TheDate is a workday (round down).

Temp = Format(TheDate, "ddd")
If Temp = "Sun" Then
TheDate = TheDate - 2
ElseIf Temp = "Sat" Then
TheDate = TheDate - 1
End If

' Calculate Weeks and OddDays.

Weeks = Int(Interval / 5)
OddDays = Interval - (Weeks * 5)
TheDate = TheDate + (Weeks * 7)

' Take OddDays weekend into account.

If (DatePart("w", TheDate) + OddDays) > 6 Then
TheDate = TheDate + OddDays + 2
Else
TheDate = TheDate + OddDays
End If

DateAddW = TheDate
Else ' Interval is < 0
Interval = Int(-Interval) ' Make positive & subtract later.

' Make sure TheDate is a workday (round up).

Temp = Format(TheDate, "ddd")
If Temp = "Sun" Then
TheDate = TheDate + 1
ElseIf Temp = "Sat" Then
TheDate = TheDate + 2
End If

' Calculate Weeks and OddDays.

Weeks = Int(Interval / 5)
OddDays = Interval - (Weeks * 5)
TheDate = TheDate - (Weeks * 7)

' Take OddDays weekend into account.

If (DatePart("w", TheDate) - OddDays) > 2 Then
TheDate = TheDate - OddDays - 2
Else
TheDate = TheDate - OddDays
End If

DateAddW = TheDate
End If

End Function



'Private Sub Application_ItemSend(ByVal Item As Object, Cancel As
Boolean)End Sub'


Cheers,
Nick
 
Frankly, I don't know what's going on. Maybe Outlook (sometimes) doesn't
like that you delete olMail within the rule?

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --


Am Tue, 28 Nov 2006 11:08:01 -0800 schrieb Nick_NZ:
 
Back
Top