Trying to save word file, from excel vba, without overwriting any existing files

Trying to save a file to a file, from excel vba, without overwriting any existing files. There is a possibility that the selected filename (taken from the spreadsheet) might be duplicate, in which case I would like to pause or stop the code, but instead it records automatically). As shown below, although my attempt at two attempts at error fails and the doc document is written above:

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

      

+3


source to share


1 answer


You can add this if statement before adding the dictionary document.



If Dir(fileToOpen) <> "" Then Exit Sub

+2


source







All Articles