| Message |
Jeff,
After many months of corespondance with the ESRI expert here in Australia, she did manage to develope a work around. I must admit I have not actually tried it but I would hope it works. In the time since I originally posted this I have changed positons and thus it had become less important to me, but any I will include the code below. If you do try it I would love to know if it works.
===================================
Instructions on how it works, from ESRI
===================================
Essentially instead of using
IApplication::SaveasDocument,
I am using the Windows API Copyfile function - as described at :
http://support.microsoft.com/kb/172711
and SUCCESSFULLY tested via the code included at the end of this email.
I have also attached the 9.2 sp5 mxd, that I created to test this code.
All you need do to do is open the mxd, run the ShowForm macro ... which
opens
a form, and then click the contained commandbutton ... and it will
successfully
run the SaveCopy procedure, which :
1. saves the existing mxd,
2. Backs up the existing mxd to a new name (replacing the
IApplication::SaveasDocument method)
3. saves the mxds again
|
| |
Option Explicit
Declare Function apiCopyFile Lib "kernel32" Alias "CopyFileA" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long
Sub saveCopy()
On Error GoTo errHandle
'get the app
Dim pApp As IApplication
Set pApp = Application
'save once
Call pApp.SaveDocument
MsgBox "saved"
'do a backup : this method gives the discovered bug
' Call pApp.SaveAsDocument("C:\Temp\Test.mxd", True)
' MsgBox "backed up"
'do a Backup : this method gives a workaround, using the Windows API
CopyFile function
' as described at : http://support.microsoft.com/kb/172711
Dim VbProj As Object
Set VbProj = pApp.Document.VBProject
Dim thePath As String
Dim newMXDFilename As String
thePath = Left(VbProj.FileName, (Len(VbProj.FileName) -
Len(pApp.Document.Title)))
newMXDFilename = thePath & "replacement.mxd"
CopyFile VbProj.FileName, newMXDFilename
MsgBox "backed up"
'save again - this fails on Windows 2000 Professional.... but with
workaround it does not fail
Call pApp.SaveDocument
MsgBox "saved again"
Exit Sub
errHandle:
MsgBox "Error: " & Err.Description & " num: " & Err.Number
End Sub
Sub CopyFile(SourceFile As String, DestFile As String)
'---------------------------------------------------------------
' PURPOSE: Copy a file on disk from one location to another.
' ACCEPTS: The name of the source file and destination file.
' RETURNS: Nothing
'---------------------------------------------------------------
Dim Result As Long
If Dir(SourceFile) = "" Then
MsgBox Chr(34) & SourceFile & Chr(34) & _
" is not valid file name."
Else
Result = apiCopyFile(SourceFile, DestFile, False)
End If
End Sub |