asked on

VBA Application.FileDialog overwrite without prompt

I am having an issue in Microsoft Access 2007.

I wrote some code that takes data and exports it to Excel. When this code runs it prompts the user to enter a file name using Application.Filedialog(2). The problem is when you type in the file name without an extension (.xls or .xlsx) and a file with that same name exists in that folder it will overwrite it without a prompt. If you type in the extension .xls or .xlsx and that file name with that extension exists it does give you the overwrite prompt.

I need a work around for this.

I found this on a forum which describes the same exact problem I am experiencing.
https://bugs.eclipse.org/bugs/show_bug.cgi?id=332178

And Microsoft describes how to work around it here but this is not working for me or I am doing it wrong.
http://msdn.microsoft.com/en-us/library/system.windows.forms.savefiledialog.overwriteprompt(v=vs.110).aspx

I have attached the original code I used which results in the file being overwritten.

Private Sub Command20_Click()
Dim filenm As String, commonDlg As Object
filenm = ""
Set commonDlg = Application.FileDialog(2)
    With commonDlg
        .AllowMultiSelect = False
        .InitialFileName = "F:\Filename"
        .Title = "Please select a folder and give the file a name"
            If .Show = True Then
              filenm = Trim(.SelectedItems.Item(1))
              
                  DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", filenm
              
              msgbox "Your spreadsheet was saved successfully"
            Else
               msgbox "You clicked Cancel in the file dialog box."
            End If
End With
End Sub

Open in new window

I tried adding this to my code but it just crashes with the error "Run-time error 438 object doesn't support this property or method"

.CreatePrompt = True
.OverwritePrompt = True

Thanks in advance for any help!
Dan

SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

SOLUTION

Scott McDaniel (EE MVE )

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

filtrationproducts

ASKER

MartinLiss,

When I add the filter code for the file extension I receive the error "Run-time error 438 - object doesn't support this property or method."

Scott,

I tried your solution as well but the problem is if the extension isn't typed in the filenm does not contain the file extension either (displays "c:\test" only not "c:\test.xls") so it will not tell me that the file exists.

Thanks for your help!
Dan

Scott McDaniel (EE MVE )

Then add the extension. You can easily check to see if the last 3 or 4 digits match a list of file extensions, and take action as needed:

If Len(filenm) > 4 Then
  Dim sExt as String
  sExt = Right(filenm, 4)
  If sExt = "xlsx" Then
    '/ nothing to do
  Else
    sExt = Right(filenm, 3)
    If sExt = "xls" Then
      '/ nothing to do
    Else
      filenm = filenm & ".xls"
    End If
else
  '/ the length of filenm is less than 4, so there is no file extension, or it's an oddly named file
  Msgbox "You must select a valid file"  
End If

Open in new window

Martin Liss

When I add the filter code for the file extension I receive the error "Run-time error 438 - object doesn't support this property or method."

I don't do Access programming but this Microsoft article shows Filters being used.

filtrationproducts

ASKER

Scott,

I tried adding your code above to my code to check for extensions. But for some reason it is completely skipping over the code and saving anyway.

Private Sub Command20_Click()
Dim filenm As String, commonDlg As Object
filenm = ""
Set commonDlg = Application.FileDialog(2)
With commonDlg
    .AllowMultiSelect = False
    .InitialFileName = "F:\"
    .Title = "Please select a folder and give the file a name"
    
      If .Show = True Then
        filenm = Trim(.SelectedItems.Item(1))
            'Checking for Excel extension
                If Len(filenm) > 4 Then
                  Dim sExt As String
                  sExt = Right(filenm, 4)
                  If sExt = "xlsx" Then
                    '/ nothing to do
                  Else
                    sExt = Right(filenm, 3)
                    If sExt = "xls" Then
                      '/ nothing to do
                    Else
                      filenm = filenm & ".xls"
                    End If
                Else
                  '/ the length of filenm is less than 4, so there is no file extension, or it's an oddly named file
                  msgbox "You must select a valid file"
                End If
                
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", filenm
        msgbox "Your spreadsheet was saved successfully"
      Else
         msgbox "You clicked Cancel in the file dialog box."
      End If
End With
End Sub

Open in new window

Scott McDaniel (EE MVE )

Move the OpenReport call up a bit:

With commonDlg
.AllowMultiSelect = False
.InitialFileName = "F:\"
.Title = "Please select a folder and give the file a name"

      If .Show = True Then
        filenm = Trim(.SelectedItems.Item(1))
            'Checking for Excel extension
                If Len(filenm) > 4 Then
                  Dim sExt As String
                  sExt = Right(filenm, 4)
                  If sExt = "xlsx" Then
                    '/ nothing to do
                  Else
                    sExt = Right(filenm, 3)
                    If sExt = "xls" Then
                      '/ nothing to do
                    Else
                      filenm = filenm & ".xls"
                    End If
                   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", filenm
                   msgbox "Your spreadsheet was saved successfully"
                Else
                  '/ the length of filenm is less than 4, so there is no file extension, or it's an oddly named file
                  msgbox "You must select a valid file"
                End If
                
      Else
         msgbox "You clicked Cancel in the file dialog box."
      End If
End With

Open in new window

filtrationproducts

ASKER

MartinLiss,

I did it like they did in that post but I was not able to get it to work. I actually tried that prior to posting this question with no success. But I am not sure why it won't accept it.

Dan

Private Sub Command20_Click()
Dim filenm As String, commonDlg As Object
filenm = ""
Set commonDlg = Application.FileDialog(2)
With commonDlg
    .AllowMultiSelect = False
    .InitialFileName = "F:\"
    .Title = "Please select a folder and give the file a name"
    
      If .Show = True Then
        filenm = Trim(.SelectedItems.Item(1))
            'Checking for Excel extension
                If Len(filenm) > 4 Then
                  Dim sExt As String
                  sExt = Right(filenm, 4)
                  If sExt = "xlsx" Then
                    '/ nothing to do
                  Else
                    sExt = Right(filenm, 3)
                    If sExt = "xls" Then
                      '/ nothing to do
                    Else
                      filenm = filenm & ".xls"
                    End If
                Else
                  '/ the length of filenm is less than 4, so there is no file extension, or it's an oddly named file
                  msgbox "You must select a valid file"
                End If
                
        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", filenm
        msgbox "Your spreadsheet was saved successfully"
      Else
         msgbox "You clicked Cancel in the file dialog box."
      End If
End With
End Sub

Open in new window

filtrationproducts

ASKER

Scott,

I updated the code like you show but it is still going straight to the "file saved" message box. I added msgbox prompts throughout the code to see if it is triggering anywhere but I am not receiving any of the msgbox windows I addded (check1 through check7).

It is as if the Application.FileDialog command is completely bypassing the code?

Dan

Private Sub Command20_Click()
Dim filenm As String, commonDlg As Object
filenm = ""
Set commonDlg = Application.FileDialog(2)
With commonDlg
    .AllowMultiSelect = False
    .InitialFileName = "F:\"
    .Title = "Please select a folder and give the file a name"
    
      If .Show = True Then
        filenm = Trim(.SelectedItems.Item(1))
            'Checking for Excel extension
                If Len(filenm) > 4 Then
                msgbox "CHECK1"
                  Dim sExt As String
                  sExt = Right(filenm, 4)
                  If sExt = "xlsx" Then
                    msgbox "CHECK2"
                    '/ nothing to do
                  Else
                  msgbox "CHECK3"
                    sExt = Right(filenm, 3)
                    If sExt = "xls" Then
                      '/ nothing to do
                      msgbox "CHECK4"
                    Else
                    msgbox "Check5"
                      filenm = filenm & ".xls"
                    End If
                   DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", filenm
                   msgbox "Your spreadsheet was saved successfully"
                Else
                msgbox "Check 6"
                  '/ the length of filenm is less than 4, so there is no file extension, or it's an oddly named file
                  msgbox "You must select a valid file"
                End If
                msgbox "check7"
      Else
         msgbox "You clicked Cancel in the file dialog box."
      End If
End With
End Sub

Open in new window

filtrationproducts

ASKER

Scratch that last post. I have two forms that are almost identical and I think I was running the wrong one while I was editing and testing the code.

Let me try it again.

Scott McDaniel (EE MVE )

May have been missing an End If. Try this:

Private Sub Command20_Click()
    Dim filenm As String, commonDlg As Object
    filenm = ""
    Set commonDlg = Application.FileDialog(2)
    With commonDlg

        .AllowMultiSelect = False
        .InitialFileName = "F:\"
        .Title = "Please select a folder and give the file a name"

        If .Show = True Then
            filenm = Trim(.SelectedItems.Item(1))
            'Checking for Excel extension
            If Len(filenm) > 4 Then
                MsgBox "CHECK1"
                Dim sExt As String
                sExt = Right(filenm, 4)
                If sExt = "xlsx" Then
                    MsgBox "CHECK2"
                    '/ nothing to do
                Else
                    MsgBox "CHECK3"
                    sExt = Right(filenm, 3)
                    If sExt = "xls" Then
                        '/ nothing to do
                        MsgBox "CHECK4"
                    Else
                        MsgBox "Check5"
                        filenm = filenm & ".xls"
                    End If
                    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", filenm
                    MsgBox "Your spreadsheet was saved successfully"
                End If
            Else
                MsgBox "Check 6"
                '/ the length of filenm is less than 4, so there is no file extension, or it's an oddly named file
                MsgBox "You must select a valid file"
            End If
            MsgBox "check7"
        Else
            MsgBox "You clicked Cancel in the file dialog box."
        End If
    End With
End Sub

Open in new window

Also, I'm not sure you should use SelectedItems.Item(1). I don't know off-hand, but most arrays and collections are zero-based, so try SelectedItems.Item(0) instead.

Scott McDaniel (EE MVE )

You're still missing an End If ... be sure to use the new code I posted.

filtrationproducts

ASKER

Ok. Now I am receiving a "else without if" on the line that says "Else" just before this line;

msgbox "You clicked Cancel in the file dialog box."

Sorry if I am being a pain but all the If statements in this code are confusing me. I put it into word and highlighted to try and figure it out but I am not seeing where i am missing something.

Private Sub Command20_Click()
Dim filenm As String, commonDlg As Object
filenm = ""
Set commonDlg = Application.FileDialog(2)
With commonDlg
    .AllowMultiSelect = False
    .InitialFileName = "F:\"
    .Title = "Please select a folder and give the file a name"
    
      If .Show = True Then
        filenm = Trim(.SelectedItems.Item(1))
            'Checking for Excel extension
                If Len(filenm) > 4 Then
                  Dim sExt As String
                  sExt = Right(filenm, 4)
                  If sExt = "xlsx" Then
                    '/ nothing to do
                  Else
                    sExt = Right(filenm, 3)
                    If sExt = "xls" Then
                      '/ nothing to do
                    Else
                      filenm = filenm & ".xls"
                        End If
                        DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", filenm
                            msgbox "Your spreadsheet was saved successfully"
      Else
         msgbox "You clicked Cancel in the file dialog box."
      End If
                Else
                  '/ the length of filenm is less than 4, so there is no file extension, or it's an oddly named file
                  msgbox "You must select a valid file"
                End If
            
End With
End Sub

Open in new window

Capture.GIF

Scott McDaniel (EE MVE )

Did you use the new code I posted? It contains the missing statement ...

filtrationproducts

ASKER

Yes, I updated it. It appears to be triggering now but it is still overwriting the files without prompt.

I added a msgbox filenm after filenm = filenm & ".xls" just to make sure it is adding the extension to the string and it is. But I type the name of a file that exists and click save and it still says it saved successfully and overwrites the file.

Dan

ASKER CERTIFIED SOLUTION

filtrationproducts

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Scott McDaniel (EE MVE )

FWIW: In my suggestion, if you wanted to prompt the user to overwrite you'd have to include code for that:

<AFTER adding the extension>
If Dir(filenm) <> "" Then
If Msgbox("Do you want to overwrite " &filenm & "?", vbYesNo, "Confirm Overwrite") = vbNo Then
Exit Sub
End If
End If

'/ now do the transferspreadsheet

filtrationproducts

ASKER

Scott,

When I add that code technically it works but then I receive two prompts to overwrite (if the user chose to yes to overwrite). The one we programmed in manually then the one we get from the application.filedialog.

Dan

filtrationproducts

ASKER

Gave points to both of you because your solutions should have worked if Application.FileDialog worked as Microsoft says it should. But since Application.FileDialog appears to be problematic/flawed I used the API version instead.

Thanks for your help!
Dan