Assuming you have access to some Microsoft Office product:
This is not elegant, but will work in Word, Excel or Access in Office XP or 2003. I am not sure about 2000 because this uses the Application.FileDialog box which was not accessible in earlier Office versions.
If you are a VBA Wiz then skip this and go on to the code, otherwise:
In Word or Excel you will need to go Tools > Macro > Visual Basic Editor and insert a module. Copy and paste the code into the module. From the visual basic editor window, go to Tools > References and in the dialog box that pops up, check the box next to Microsoft MapPoint 9.0 Object Library (or whatever your version is). Save the module. Run the module by pressing F5 while the Visual Basic Editor is the active window.
The same basic stuff will work in Visual Basic, with the exception of the FileDialog, you will need to replace it with the CommonDialog control or some other way of getting the file paths and names.
Code:
Private Sub CopyShapes()
'general variables
Dim srcFile As String
Dim targFile As String
Dim selItem As Variant
' Dim mpYellow As Long
'mappoint variables
Dim MPApp1 As MapPoint.Application
Dim MPApp2 As MapPoint.Application
Dim MPMap1 As MapPoint.Map
Dim MPMap2 As MapPoint.Map
Dim MPShape As MapPoint.Shape
'application variables
Dim FD As FileDialog
' mpYellow = &HFFFF&
'set up file dialog and get source file name
Set FD = Application.FileDialog(msoFileDialogFilePicker)
FD.AllowMultiSelect = False
FD.Filters.Clear
FD.Filters.Add "MapPoint Files", "*.ptm"
'select target file
With FD
.Title = "Select the file to which you want to copy:"
If .Show = -1 Then
For Each selItem In FD.SelectedItems
targFile = selItem
Next
Else
'user pressed cancel, no file to process so exit
Exit Sub
End If
End With
'initialize target map
Set MPApp1 = CreateObject("Mappoint.Application")
Set MPMap1 = MPApp1.OpenMap(targFile, False)
'you might want to put this at the end
'the map spins and moves around a lot as the
'copy work is being done
'disadvantage to moving to the end is if an error occurs
'MapPoint will run in the background unless you kill it in the
'task manager
MPApp1.Visible = True
MPApp1.UserControl = True
Application.Activate
'select source files
With FD
.AllowMultiSelect = True
.Title = "Copy shapes from:"
If .Show = -1 Then
For Each selItem In FD.SelectedItems
srcFile = selItem
Set MPApp2 = CreateObject("Mappoint.Application")
Set MPMap2 = MPApp2.OpenMap(srcFile, True)
MPApp2.Visible = True
MPApp2.UserControl = True
'this part will make you dizzy if you choose to
'make the applications visible
For Each MPShape In MPMap2.Shapes
If MPShape.Type = geoFreeform Or geoAutoShape Then
MPShape.Copy
MPMap1.Paste
End If
Next
Next
Else
'user pressed cancel, no file to process so exit
Exit Sub
End If
End With
'clean up
Set MPApp1 = Nothing
Set MPApp2 = Nothing
Set MPMap1 = Nothing
Set MPMap2 = Nothing
Set MPShape = Nothing
Set FD = Nothing
End Sub