I am trying to get the JournalMove custom form downloaded from
http://www.outlookcode.com/d/forms/saveinfolder.htm in Outlook 2003
with Exchange

I want to save the item to a public folder. I got the form to work if
I launch it from my personal folder--it works perfect. But the client
needs to somehow connect the contact to the journal entry and since the
"New Journal for Contact" does not seem to work with custom forms, I
was dragging and dropping the contact onto the public folder in which I
want to save the journal item. This launches the custom form, but when
I save I get an error "Can't move the items". I'm afraid I am new to
the Outlook model and I am not sure I completely understand this code,
although I do understand the concept. I've copied the code below as
modified for my environment. Appreciate any help.

(when the code stops, the value of objCopy.Parent.FolderPath =
"\\Public Folders\All Public Folders\Client\Client Journal" while the
value of item.Parent.FolderPath = "\\Mailbox - Bender, Cheryl\Journal",
so I can't understand why it says it cannot move the item.)

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 = "Public Folders/All Public Folders/Client/Client
Journal"
' 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
if objCopy.Parent.FolderPath item.Parent.FolderPath then
objCopy.Move objTargetFolder
else
objCopy.Save
end if
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

Some additional info, when I went to close out the form and set the
folder back to the default form I saw that it had saved all of my
attempts in the public folder even though the code tripped the error.

Thanks
Cheryl

wrote:
I am trying to get the JournalMove custom form downloaded from
http://www.outlookcode.com/d/forms/saveinfolder.htm in Outlook 2003
with Exchange

I want to save the item to a public folder. I got the form to work if
I launch it from my personal folder--it works perfect. But the client
needs to somehow connect the contact to the journal entry and since the
"New Journal for Contact" does not seem to work with custom forms, I
was dragging and dropping the contact onto the public folder in which I
want to save the journal item. This launches the custom form, but when
I save I get an error "Can't move the items". I'm afraid I am new to
the Outlook model and I am not sure I completely understand this code,
although I do understand the concept. I've copied the code below as
modified for my environment. Appreciate any help.

(when the code stops, the value of objCopy.Parent.FolderPath =
"\\Public Folders\All Public Folders\Client\Client Journal" while the
value of item.Parent.FolderPath = "\\Mailbox - Bender, Cheryl\Journal",
so I can't understand why it says it cannot move the item.)

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 = "Public Folders/All Public Folders/Client/Client
Journal"
' 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
if objCopy.Parent.FolderPath item.Parent.FolderPath then
objCopy.Move objTargetFolder
else
objCopy.Save
end if
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

(when the code stops, the value of objCopy.Parent.FolderPath =
"\\Public Folders\All Public Folders\Client\Client Journal"

In other words, the copy's parent folder is already the target folder. You can't move an item into the folder where it already exists. (Why Item.Parent.FolderPath is the default Journal folder, I can't explain.)

A good solution for your scenario would be a custom contact form with a custom action and code in the CustomActions event handler to create a new journal entry directly in the target folder. Alternatively, you could make the "save in folder" journal form the default form for all journal items, if that would work in your client's environment; see http://www.outlookcode.com/d/newdefaultform.htm

--
Sue Mosher, Outlook MVP
Author of Configuring Microsoft Outlook 2003
http://www.turtleflock.com/olconfig/index.htm
and Microsoft Outlook Programming - Jumpstart for
Administrators, Power Users, and Developers
http://www.outlookcode.com/jumpstart.aspx

wrote in message ps.com...
I am trying to get the JournalMove custom form downloaded from
http://www.outlookcode.com/d/forms/saveinfolder.htm in Outlook 2003
with Exchange

I want to save the item to a public folder. I got the form to work if
I launch it from my personal folder--it works perfect. But the client
needs to somehow connect the contact to the journal entry and since the
"New Journal for Contact" does not seem to work with custom forms, I
was dragging and dropping the contact onto the public folder in which I
want to save the journal item. This launches the custom form, but when
I save I get an error "Can't move the items". I'm afraid I am new to
the Outlook model and I am not sure I completely understand this code,
although I do understand the concept. I've copied the code below as
modified for my environment. Appreciate any help.

(when the code stops, the value of objCopy.Parent.FolderPath =
"\\Public Folders\All Public Folders\Client\Client Journal" while the
value of item.Parent.FolderPath = "\\Mailbox - Bender, Cheryl\Journal",
so I can't understand why it says it cannot move the item.)

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 = "Public Folders/All Public Folders/Client/Client
Journal"
' 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
if objCopy.Parent.FolderPath item.Parent.FolderPath then
objCopy.Move objTargetFolder
else
objCopy.Save
end if
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