Hi,

I'm working with a case management system at our office. The templates we have been supplied that pull data from the management software to create Word docs all need amending in small ways, but a major oversight in the code supplied to us is that there is no check to see if a document exists before saving. As the firm may write several letters to a client or other company a day I need to have the system set up to handle this.

I've hacked around a little with the code supplied and have managed to force it to check if a document with a certain name exists and save with the suffix "2" if it does, but ideally I'd like to find something a little more elegant that will cope with dozens of documents being saved with the same name.

Here's the current code:

Sub PURCH()
'
' LETTER Macro
' Macro created 07/11/2001 by ***************
' Edited 01/12/2008 by ****************
'
Application.WindowState = wdWindowStateMinimize
Dim MMMDoc As Document
' This part creates a new document based on the open template
Set MMMDoc = Documents.Open("W:\LAWPRO\MASTERDOCS\PUR10.dot")
'***************************************

ActiveDocument.MailMerge.OpenDataSource Name:="C:\WPDOCS\PURCH.DOC", _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _
:=""
ActiveDocument.MailMerge.ViewMailMergeFieldCodes = False

With MMMDoc.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=True
End With

MMMDoc.Close SaveChanges:=wdDoNotSaveChanges

Set MMMDoc = Nothing

Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="CasePath"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="Desc"
.DefaultSorting = wdSortByName
.ShowHidden = False
End With
' This part goes to the start of the document and sets up a Bookmark called CasePath using the field CASEPATH from Lawmaster


' Desc = ActiveDocument.Bookmarks("Desc").Range.Text
CasePath = ActiveDocument.Bookmarks("CasePath").Range.Text
ChangeFileOpenDirectory CasePath

' This section directs Word to save the open document with a particular name in the correct directory.
' It checks first whether the file exists and saves it with the suffix "2" if it does.

If Dir(Format(Now(), "mm dd yy") & " Concluding Missive" & ".doc") <> "" Then

' This line of code forces a filename in the format "mm dd yy xxx.doc", e.g. "12 24 08 Concluding Missive.doc".

ActiveDocument.SaveAs FileName:=Format(Now(), "mm dd yy") & " Concluding Missive 2" & ".doc", FileFormat:=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False

' After saving the document the two bookmarks are removed then the document is resaved.
' The cursor is then sent to the end of the document and Word is maximised to allow the user to carry on typing.

Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
CommandBars("Mail Merge").Visible = False

ActiveDocument.Save
Selection.EndKey Unit:=wdStory
Application.WindowState = wdWindowStateMaximize

Selection.EndKey Unit:=wdStory
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
CommandBars("Mail Merge").Visible = False
ActiveDocument.Save
Application.WindowState = wdWindowStateMaximize
Selection.HomeKey Unit:=wdStory

Else

ActiveDocument.SaveAs FileName:=Format(Now(), "mm dd yy") & " Concluding Missive" & ".doc", FileFormat:=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False

' After saving the document the two bookmarks are removed then the document is resaved.
' The cursor is then sent to the end of the document and Word is maximised to allow the user to carry on typing.

Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
CommandBars("Mail Merge").Visible = False

ActiveDocument.Save
Selection.EndKey Unit:=wdStory
Application.WindowState = wdWindowStateMaximize

Selection.EndKey Unit:=wdStory
Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
CommandBars("Mail Merge").Visible = False
ActiveDocument.Save
Application.WindowState = wdWindowStateMaximize
Selection.HomeKey Unit:=wdStory

End If

End Sub

Any ideas?

Thanks in advance!

No ideas? :-)

dim filefound as boolean

filefound = dir("fullpathtofile")<>vbnullstring


---------
this code uses the inbuilt dir command to find file(s) matching a given spec - so if you include the full spec it will either return the same string - indicating it found the file, or a blank string - indicating it didnt

any use?

if I am understaning correctly...
not elegant, but not a lot of work would be to use the Time or random number to concatenate to the file name if the doc already exists