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