wonder if anyone can help... I have access db with a whole lot of vb code... If i use access 2000 it works perfectly but when using 2003 it doesn't work properly. The db copies outlook mailboxes... I'm not quite sure why it wont work properly, i can copy my own mailbox but trying to copy some elses wont work, if i export the mailboxes directly through outlook then i can copy them... this isn't an outlook related issue... here is the code which doesn't seem to work:
Any ideas or anything would be greatly appreciated...
Thanx
Code:
Private Sub CopyMailItems(ns As Outlook.NameSpace, strUserFullName As String, strRecip As String)
On Error GoTo CopyErrHandler
Dim folder1 As MAPIFolder, oFolder As MAPIFolder
Dim strMailboxName As String, strStatus As String
Dim intConnect As Integer, intOther As Integer
Dim strDupTest As String, ErrString, strSearch As String
Dim Complete As Boolean
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Status")
MsgBox "copymailitems1", vbOKOnly, "test"
intConnect = ConnectToBox()
If intConnect = 6 Then
MsgBox "copymailitems2", vbOKOnly, "test"
strMailboxName = "Mailbox - " & strUserFullName
Set UserMailbox = ns.Folders(strMailboxName)
'If user has not connected to mailbox, rest of code will not run. Error Handler will "kick in"
strStatus = StatusTest()
MsgBox "copymailitems3", vbOKOnly, "test"
If strStatus <> "Copy Started" Then
MsgBox "copymailitems4", vbOKOnly, "test"
strStatus = "Copy Started"
Call UpdateStatus(strStatus)
End If
Screen.MousePointer = 11
'Copy folders and its subfolders to empty pst
strPstFolderName = CreateEmptyPst(ns, strRecip, strUserFullName)
MsgBox "copymailitems5", vbOKOnly, "test"
Set PersonalFolder = ns.Folders(strPstFolderName)
For Each folder1 In UserMailbox.Folders 'ns.Folders(strMailboxName).Folders
MsgBox "copymailitems6", vbOKOnly, "test"
Set CopiedFolder = folder1.CopyTo(PersonalFolder) '****
MsgBox "copymailitems7", vbOKOnly, "test"
Next
MsgBox "copymailitems8", vbOKOnly, "test"
Set CopiedFolder = Nothing
'copy messages from top of Information Store to pst
For Each msg In ns.Folders(strMailboxName).Items
MsgBox "copymailitems9", vbOKOnly, "test"
Set CopiedItem = msg.Copy
CopiedItem.Move PersonalFolder
Next
Set CopiedItem = Nothing
Set oFolder = ns.Folders.Item(strPstFolderName)
Screen.MousePointer = 0
Complete = VerifyContents(ns, strMailboxName)
If Complete = True Then
MsgBox "All items have been copied.", vbOKOnly + vbInformation, "Mailbox Copy"
strStatus = "Copy Complete"
' Set objFolder = objName.Folders.Item("Personal Folders")
ns.RemoveStore PersonalFolder
Else
MsgBox "Please copy data to folders where differences have been noted. " & _
"Please revisit page once copying has been completed", vbOKOnly + vbInformation, _
"Mailbox Copy"
strStatus = "Copy Partial"
DoCmd.OpenForm "frmCopyComplete"
End If
Call UpdateStatus(strStatus)
End If
CopyErrHandler:
Select Case Err.Number
Case -2147221233 'Not connected to user's mailbox in Outlook
intConnect = ConnectToBox()
If intConnect = 6 Then
Resume
End If
Case Else
strSearch = "Can't copy folder." 'don't have permission to copy folder
ErrString = InStr(1, Err.Description, strSearch)
If ErrString = 1 Then
Resume Next
End If
End Select
Screen.MousePointer = 0
End Sub
i have added the msgboxs which says copymailitems, just to try see where it stops working... it would seem like it is after this line:
MsgBox "copymailitems6", vbOKOnly, "test"
Set CopiedFolder = folder1.CopyTo(PersonalFolder)
Thanx