add counter in file exists vba

[dean.rogers]

Hey all,

I am using excel 07 vba to create a word doc. Currently when in my code I have it save as right away to make sure not to affect my template. What I need to do is add a count integer to the save as so if the file exists, it will save like this: fileexists (1).docx

Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Set wrdApp = CreateObject("Word.Application")
   
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Templates\MyTemplate.docx"
'this saves the file as the value in cell D3           
wrdApp.ActiveDocument.SaveAs "C:\Templates\ " & ActiveWorkbook.Sheets("Sheet1").Range("D3").value & " .docx"

This works great, but i know in order to add a count integer i need to make a statement at the beginning and then add an IF statement that will save it as it is currently if the file doesn't already exist and IF it does exist then Save As with the integer...

Thanks for your help!!

 

[guerillaunit]

Sub test()
 
Dim wrdApp As Variant
Dim wrdDoc As Variant
 
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Templates\MyTemplate.docx")
 
If File_Exists("D:\Documents and Settings\10130590\Desktop\test\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & ".doc") = False Then
    wrdApp.ActiveDocument.SaveAs "C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & ".docx"
Else
    wrdApp.ActiveDocument.SaveAs "C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "1.doc"
End If
 
End Sub

This is assuming you'll only have a max of 1 other file with D3's value as its name in your folder

 

[dean.rogers]

Hey guerillaunit, thanks for the reply. I am curious what the documents and settings piece is? Also if possible, if you could add an integer into the code that would work if many saves were made. I am trying to make it as dummy proof as possible!

Thanks!!

 

[guerillaunit]

Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean
 
On Error Resume Next
 
If sPathName <> "" Then
    If IsMissing(Directory) Or Directory = False Then
        File_Exists = (Dir$(sPathName) <> "")
    Else
        File_Exists = (Dir$(sPathName, vbDirectory) <> "")
    End If
End If
 
End Function
 
 
Sub test()
 
Dim wrdApp As Variant
Dim wrdDoc As Variant
 
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Templates\MyTemplate.docx")
 
If File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("sheet1").Range("d3").Value & ".doc") = False Then
    wrdApp.ActiveDocument.SaveAs "C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & ".doc"
ElseIf File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & ".doc") = True And _
    File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "1.doc") = False And _
    File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "2.doc") = False Then
    wrdApp.ActiveDocument.SaveAs "C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "1.doc"
ElseIf File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & ".doc") = True And _
    File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "1.doc") = True And _
    File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "2.doc") = False Then
    wrdApp.ActiveDocument.SaveAs "C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "2.doc"
ElseIf File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & ".doc") = True And _
    File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "1.doc") = True And _
    File_Exists("C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "2.doc") = True Then
    wrdApp.ActiveDocument.SaveAs "C:\Templates\" & ActiveWorkbook.Sheets("Sheet1").Range("D3").Value & "3.doc"
End If
 
wrdApp.ActiveDocument.Close
wrdApp.Quit
Set wrdApp = Nothing
 
End Sub

The above will allow you to save up to 4 copies of a workbook with the same name

 

[dean.rogers]

Hey Guerillaunit,

Thanks for the code. I figure this will have to do considering that is the approach that you are familiar with. Something to note is that the vba doesn't like the file_exists part. If i remove that from the code however it works perfect.

Thanks so much for your help!!

 

[guerillaunit]

File_exists is a custom function. Unless you have it defined elsewhere in your module, the function that saves your word file won't work

 

[dean.rogers]

Thanks, I realized that after it didn't work, when I added the private function it worked perfect.

Being that I am new to vba, I know what the private function is doing but still don't know some of the code that was used...

Are there any drawbacks or things to keep in mind as my project moves forward with the code tha you provided?

 

[dean.rogers]

Through testing I was able to find another potential error that someone could run in to. The error was "cannot save file is already open"....The error was a result to the fact i had created one file after another which resulted in having the "filename (3).docx" open and then tried to save over it.

Are you not sure how to incorporate an integer that would allow you to hypothetically save infinite?