Create a unique filename 2

[zimmer9]

I have created a query and exported it to Excel.
I'm at the point of saving my ActiveWorkbook as follows:
objXL.ActiveWorkbook.SaveAs FILENAME

I wanted to create a unique file name each time the Excel file gets generated. How would I create a unique filename so that the first time a file named C:\FALL1.XLS
gets generated ?

Then, perhaps a week later, generate the same Excel file and save the file as C:\FALL2.XLS

Then, if I subsequently delete C:\FALL2.XLS, the next time I generate the file, it would be saved as C:\FALL2.XLS again.

Thus, the C:\ root directory would be searched to see the next available generation number of C:\FALL(incremented number).XLS to create. I am trying to figure how to do this programatically using VBA.

 

[VBslammer]

Call a function with the path and filename of the first expected file, like:

strNextFile = GetNextFileName("C:\FILE1.txt")

The function can use Dir() in a loop to count the instances that match the base file name, and return the filename with an incremented counter:

Function GetNextFileName(ByVal strFile As String) As String
  Dim strResult As String
  Dim intCount As Integer
  
  strResult = Replace(strFile, "1", "*") [green]'add wildcard[/green]
  strResult = Dir(strResult)
  
  While strResult <> ""
    intCount = intCount + 1
    strResult = Dir()
  Wend
  
  GetNextFileName = Replace(strFile, "1", intCount + 1)
  
End Function

VBSlammer

"You just have to know which screws to turn." - Professor Bob

 

[zimmer9]

As a followup, my intent is to export a query and display an Excel file with a temporary file name.

I only want to save the file after the user has intended to do so.

Currently I am opening and saving an Excel file before the user has had a chance to decide whether or not he or she wishes to do so.

After the Excel file opens, once the user closes the file,
he or she is automatically given a message as follows:

Do you want to save the changes you made to (for ex FALL30.XLS ?

If the user says no, an empty data set named
FALL30.XLS will be saved on their hard drive. A file is saved no matter what.

I used the following code to export a query to Excel and save the Excel file:

Dim rstQueryFS As ADODB.Recordset
Dim objXL As Excel.Application
Dim objWS As Excel.Worksheet
Dim fld As ADODB.Field

Set rstQueryFS = New ADODB.Recordset
Set rstQueryFS = _ CurrentProject.Connection.Execute "qryCuPFQ", ,_ adCmdStoredProc)
Set objXL = New Excel.Application
objXL.Workbooks.Add
strNextFile = GetNextFileName("C:\FALL1.XLS")
objXL.ActiveWorkbook.SaveAs strNextFile
Set objWS = objXL.ActiveSheet

 

[zimmer9]

I call the following sub function to export a query to Excel. The Excel spreadsheet opens and display a file name in the title bar, for example UDFALL26, which works fine. The problem is that if the user closes the Excel file by clicking on the CLOSE button in the top right corner, a message appears: Do you want to save the changes you made to UDFALL26.XLS ?

If the user clicks the "NO" command button, the Excel file is saved as an empty file. Is there a way to delete this empty file as part of housekeeping when the user choose the command button "NO". Otherwise, everytime the user chooses not to save the Excel file, he or she is left with another empty Excel file.


Private Sub FallUDQuery()
Dim rstQueryFS As ADODB.Recordset
Dim objXL As Excel.Application
Dim objWS As Excel.Worksheet
Dim fld As ADODB.Field
Dim intCol As Integer
Dim intRow As Integer
Set rstQueryFS = New ADODB.Recordset
Set rstQueryFS = CurrentProject.Connection.Execute(strSQLPrefix)
'Set rstQueryFS = CurrentProject.Connection.Execute("strSQLPrefix", , adCmdStoredProc)
Set objXL = New Excel.Application
objXL.Workbooks.Add
strNextFile = GetNextFileName("C:\UDFALL1.XLS")
objXL.ActiveWorkbook.SaveAs strNextFile
Set objWS = objXL.ActiveSheet

For intCol = 0 To rstQueryFS.Fields.Count - 1
Set fld = rstQueryFS.Fields(intCol)
objWS.Cells(1, intCol + 1) = fld.Name
Next intCol

intRow = 2
Do Until rstQueryFS.EOF
For intCol = 0 To rstQueryFS.Fields.Count - 1
If intCol = 15 Then
objWS.Cells(intRow, intCol + 1).NumberFormat = "000-00-0000"
End If
If intCol = 18 Then
objWS.Cells(intRow, intCol + 1).NumberFormat = "#0.000"
End If
If intCol = 24 Then
objWS.Cells(intRow, intCol + 1).NumberFormat = "@"
End If
If intCol = 27 Then
objWS.Cells(intRow, intCol + 1).NumberFormat = "#0.000"
End If
If intCol = 28 Then
objWS.Cells(intRow, intCol + 1).NumberFormat = "#0.000"
End If
If intCol = 29 Then
objWS.Cells(intRow, intCol + 1).NumberFormat = "#0.000"
End If
objWS.Cells(intRow, intCol + 1) = _
rstQueryFS.Fields(intCol).Value
objWS.Cells.EntireColumn.AutoFit

Next intCol
rstQueryFS.MoveNext
intRow = intRow + 1
Loop


objXL.Visible = True

End Sub

 

[VBslammer]

Move your "SaveAs" code after all the updates are done and the user won't be prompted to save at all:

 objXL.ActiveWorkbook.SaveAs strNextFile
 objXL.Visible = True
             
End Sub

If you want them to have a choice, you can prompt them after the workbook is finished, and if they choose cancel then close the workbook without saving it at all:

  objXL.Visible = True
  
  [green]'show saveas dialog with new filename as default[/green]
  If objXL.Dialogs(xlDialogSaveAs).Show(strNextFile) = False Then
    [green]'if they cancel, close without saving[/green]
    objXL.ActiveWorkbook.Close False
  End If

End Sub

VBSlammer

"You just have to know which screws to turn." - Professor Bob

 

[zimmer9]

I appended the If ... End If statement to the end of my procedure as I believe you suggested as follows:

Next intCol
rstQueryFS.MoveNext
intRow = intRow + 1
Loop
objXL.Visible = True

'show saveas dialog with new filename as default
If objXL.Dialogs(xlDialogSaveAs).Show(strNextFile) = False Then
'if they cancel, close without saving
objXL.ActiveWorkbook.Close False
End If

What happens now when I execute my application is the spreadsheet appears on the screen for a split second. Then it is overlayed by a Save As screen which displays the following:

Save As
Look in C:
followed by a listing of the files and folders on my C: drive
then at the bottom of the screen is the following:
Filename Save
Files of Type: Cancel

I also get an accompanying Warning dialog box with the following message:

Microsoft Access
This action cannot be completed because the Microsoft Excel - UDFALL34 application (Microsoft Excel-UDFALL34) is not responding. Choose Switch To Activate Microsoft Excel-UDFALL34 and correct the problem.

 

[VBslammer]

It looks as if the workbook has already been saved since the name of the workbook is shown in the error message. The idea is to remove your SaveAs code from the beginning of the routine and let the user decide to save or cancel at the end of it.

What versions of Access/Excel are you using? When I tested the SaveAs dialog on Access/Excel 2000, the dialog opened with the custom filename (whatever is in the strNextFile variable) as the "File Name:" entry, and it opened in the same directory the strNextFile variable specified (will default to C: drive if the path is invalid), and the Save As Type was "Microsoft Excel Workbook (*.xls)"

Also, the error message you're receiving occurs when Excel loses the focus while the SaveAs dialog is active, which often happens during debugging if you switch between the VBA IDE and the automation application, such as when you put a breakpoint in the code and step through it line by line. Try putting this line in the code:

  objXL.Visible = True
  objXL.ActiveWorkbook.Activate

I don't think it will make a difference but sometimes it does. I'm really more curious as to why the SaveAs dialog didn't open with the default filename properly. Here is the signature of its routine:

Function Excel.Dialogs(xlDialogSaveAs).Show(filename, fileFormat, password, writeResPassword, readOnlyRecommended, createBackup) As Boolean

In the IDE, the argument names are generic because each dialog type uses a different signature, so what you see is:

  objXL.Dialogs(xlDialogSaveAs).Show([arg1], [arg2], ...[arg30]) As Boolean

...so you have to find out what the actual argument order is on your own. Another method that gives you more control over the dialog is to use the Excel Application object to get the filename. Look as this example:

  Dim strSaveName As String
  
  strSaveName = objXL.GetSaveAsFilename(strNextFile, _
        "Custom Excel Workbook (*.xls),*.xls", , "Please Use Default Filename")
  
  If strSaveName <> "False" Then
    objXL.ActiveWorkbook.SaveAs strSaveName
  Else
    objXL.ActiveWorkbook.Close False
  End If

This method allows you to supply a default filename, a custom dialog title, and a custom dialog filter. If the user cancels the dialog, the workbook is closed without saving, but if they accept the supplied default filename or change it and click the save button it is saved and left open.

VBSlammer

"You just have to know which screws to turn." - Professor Bob