R
Rafael
I have a nice VBA script that copies all selected contacts to any folder
selected. One of my users told me that the server was a bit slow he
cancelled the copy process and he seems to think that this was the reason
one one particular contact was duplicated 75 times.
Personally, I don't believe it. But deep inside me, I think it's possible.
See script below.
Thanks,
Rafael
//////COPY CONTACTS SCRIPT//////
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Set myolapp = CreateObject("Outlook.Application")
Set olns = myolapp.GetNamespace("MAPI")
MsgBox "After clicking OK, you will be prompted to select a DESTINATION
contacts
folder. ", vbInformation, "Select DESTINATION Folder."
Set Destfolder = olns.PickFolder
Set DestItmes = Destfolder.Items
'set selection function
Set myOlExp = myolapp.ActiveExplorer
Set myOlSel = myOlExp.Selection
Set myItems = myOlExp.CurrentFolder.Items
Count = 0
For i = 1 To myOlSel.Count
Set myItem = myItems(i)
EM = myItem.Email1Address
Set DestItem = Destfolder.Items.Find _
("[Email1Address] = """ & EM & """")
If DestItem Is Nothing Then
Set mycopieditem = myItem.Copy
mycopieditem.Move Destfolder
Count = Count + 1
End If
Next
MsgBox Count & " Contacts were copied to " & Destfolder & ".",
vbInformation,
"Contacts have been copied"
Set myOlExp = Nothing
Set myOlSel = Nothing
Set myolapp = Nothing
Set myItems = Nothing
Set myItem = Nothing
Set sourcefolder = Nothing
Set Destfolder = Nothing
Set myItems = Nothing
Set mycopieditem = Nothing
Set DestItem = Nothing
End Sub
selected. One of my users told me that the server was a bit slow he
cancelled the copy process and he seems to think that this was the reason
one one particular contact was duplicated 75 times.
Personally, I don't believe it. But deep inside me, I think it's possible.
See script below.
Thanks,
Rafael
//////COPY CONTACTS SCRIPT//////
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Set myolapp = CreateObject("Outlook.Application")
Set olns = myolapp.GetNamespace("MAPI")
MsgBox "After clicking OK, you will be prompted to select a DESTINATION
contacts
folder. ", vbInformation, "Select DESTINATION Folder."
Set Destfolder = olns.PickFolder
Set DestItmes = Destfolder.Items
'set selection function
Set myOlExp = myolapp.ActiveExplorer
Set myOlSel = myOlExp.Selection
Set myItems = myOlExp.CurrentFolder.Items
Count = 0
For i = 1 To myOlSel.Count
Set myItem = myItems(i)
EM = myItem.Email1Address
Set DestItem = Destfolder.Items.Find _
("[Email1Address] = """ & EM & """")
If DestItem Is Nothing Then
Set mycopieditem = myItem.Copy
mycopieditem.Move Destfolder
Count = Count + 1
End If
Next
MsgBox Count & " Contacts were copied to " & Destfolder & ".",
vbInformation,
"Contacts have been copied"
Set myOlExp = Nothing
Set myOlSel = Nothing
Set myolapp = Nothing
Set myItems = Nothing
Set myItem = Nothing
Set sourcefolder = Nothing
Set Destfolder = Nothing
Set myItems = Nothing
Set mycopieditem = Nothing
Set DestItem = Nothing
End Sub