Trying to save word file, from excel vba, without over-writing any existing files. The possibility exists that the filename chosen (taken from the spreadsheet) may be a duplicate, in which case I would like to pause or stop the code, but instead it over-writes automatically) As below, though my two prong attempt to error catch fails, and the word document is over written:
Sub automateword() Dim fileToOpen As String Dim intChoice As Integer Dim myFile As Object mysheet = ActiveWorkbook.Name Set Wst = Workbooks(mysheet).ActiveSheet Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False 'make the file dialog visible to the user intChoice = Application.FileDialog(msoFileDialogOpen).Show If intChoice <> 0 Then 'get the file path selected by the user fileToOpen = Application.FileDialog( _ msoFileDialogOpen).SelectedItems(1) End If Set wordapp = CreateObject("word.Application") Set myFile = wordapp.documents.Add(fileToOpen) i = 1 Do Until IsEmpty(Wst.Cells(i, 2)) i = i + 1 Loop i = i - 1 wordapp.Visible = True Filename = Wst.Cells(i, 2) + " " + Wst.Cells(i, 3) + Str(Wst.Cells(i, 10)) On Error GoTo errorline wordapp.DisplayAlerts = True FullPath = "\networkpath\" & Filename & ".doc" myFile.SaveAs (FullPath) Exit Sub errorline: MsgBox ("filename error") End Sub
You can add this if-statement before adding a word document.
If Dir(fileToOpen) <> "" Then Exit Sub