A
An Dong
hello,
i want to make my forms (based on the task form) "understand" where
they have to save. i found a function but it doesn't work. i don't
know if it's because my outlook is french... how can i know the full
path to the target folder where i want to save items using this form ?
here is the code i found. the only thing to do, it seems, is to enter
the full path to the target folder.
Thank you
AnDong
Option Explicit
Const olDiscard = 1
Const olAppointment = 26
Const olJournal = 42
Dim mstrTargetFolder
Dim mblnSaveInTarget
Dim mblnResetStart
Sub InitOpts()
' #### USER OPTIONS ####
' set path to target folder here
mstrTargetFolder = "Personal Folders/Journal/test"
' reset Start date to Now, rather than published form date
mblnResetStart = True
End Sub
Function Item_Open()
If Item.Size = 0 Then
' for appointments and journal items, set Start
' according to option in InitOpts
If mblnResetStart Then
If Item.Class = olAppointment Or _
Item.Class = olJournal Then
Item.Start = Now
End If
End If
If Item.BillingInformation <> "IsCopy" Then
mblnSaveInTarget = True
Call InitOpts
End If
End If
End Function
Function Item_Write()
Dim objCopy
Dim objTargetFolder
If mblnSaveInTarget And Not Item.Saved Then
Set objTargetFolder = GetMAPIFolder(mstrTargetFolder)
If Not objTargetFolder Is Nothing Then
Item.BillingInformation = "IsCopy"
Set objCopy = Item.Copy
objCopy.Move objTargetFolder
Item_Write = False
Item.Close olDiscard
End If
End If
Set objCopy = Nothing
Set objTargetFolder = Nothing
End Function
Function GetMAPIFolder(strName)
Dim objNS
Dim objFolder
Dim objFolders
Dim arrName
Dim I
Dim blnFound
Set objNS = Application.GetNamespace("MAPI")
arrName = Split(strName, "/")
Set objFolders = objNS.Folders
blnFound = False
For I = 0 To UBound(arrName)
For Each objFolder In objFolders
If objFolder.Name = arrName(I) Then
Set objFolders = objFolder.Folders
blnFound = True
Exit For
Else
blnFound = False
End If
Next
If blnFound = False Then
Exit For
End If
Next
If blnFound = True Then
Set GetMAPIFolder = objFolder
End If
Set objNS = Nothing
Set objFolder = Nothing
Set objFolders = Nothing
End Function
i want to make my forms (based on the task form) "understand" where
they have to save. i found a function but it doesn't work. i don't
know if it's because my outlook is french... how can i know the full
path to the target folder where i want to save items using this form ?
here is the code i found. the only thing to do, it seems, is to enter
the full path to the target folder.
Thank you
AnDong
Option Explicit
Const olDiscard = 1
Const olAppointment = 26
Const olJournal = 42
Dim mstrTargetFolder
Dim mblnSaveInTarget
Dim mblnResetStart
Sub InitOpts()
' #### USER OPTIONS ####
' set path to target folder here
mstrTargetFolder = "Personal Folders/Journal/test"
' reset Start date to Now, rather than published form date
mblnResetStart = True
End Sub
Function Item_Open()
If Item.Size = 0 Then
' for appointments and journal items, set Start
' according to option in InitOpts
If mblnResetStart Then
If Item.Class = olAppointment Or _
Item.Class = olJournal Then
Item.Start = Now
End If
End If
If Item.BillingInformation <> "IsCopy" Then
mblnSaveInTarget = True
Call InitOpts
End If
End If
End Function
Function Item_Write()
Dim objCopy
Dim objTargetFolder
If mblnSaveInTarget And Not Item.Saved Then
Set objTargetFolder = GetMAPIFolder(mstrTargetFolder)
If Not objTargetFolder Is Nothing Then
Item.BillingInformation = "IsCopy"
Set objCopy = Item.Copy
objCopy.Move objTargetFolder
Item_Write = False
Item.Close olDiscard
End If
End If
Set objCopy = Nothing
Set objTargetFolder = Nothing
End Function
Function GetMAPIFolder(strName)
Dim objNS
Dim objFolder
Dim objFolders
Dim arrName
Dim I
Dim blnFound
Set objNS = Application.GetNamespace("MAPI")
arrName = Split(strName, "/")
Set objFolders = objNS.Folders
blnFound = False
For I = 0 To UBound(arrName)
For Each objFolder In objFolders
If objFolder.Name = arrName(I) Then
Set objFolders = objFolder.Folders
blnFound = True
Exit For
Else
blnFound = False
End If
Next
If blnFound = False Then
Exit For
End If
Next
If blnFound = True Then
Set GetMAPIFolder = objFolder
End If
Set objNS = Nothing
Set objFolder = Nothing
Set objFolders = Nothing
End Function