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
LVL 1
filtrationproductsAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
How about adding filters so there always has to be either an xls or xlsx extension. It would be done like this in Excel VBA

             .Filters.Clear
             .Filters.Add "Excel", "*.xls; *.xlsx"
0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
IMO you should check if the file exists, and take action if you find a match.
If .Show = True Then
  filenm = Trim(.SelectedItems.Item(1))
  If Dir(filenm) <> "" Then
    If MsgBox("Overwrite the file?", vbYesNo, "Confirm File Overwrite") = vbYes Then
      Kill filenm
    Else
     Exit Sub
    End If
  End If
  
  DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", filenm
  etc etc

Open in new window

0
filtrationproductsAuthor Commented:
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
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
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

0
Martin LissOlder than dirtCommented:
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.
0
filtrationproductsAuthor Commented:
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

0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
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

0
filtrationproductsAuthor Commented:
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

0
filtrationproductsAuthor Commented:
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

0
filtrationproductsAuthor Commented:
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.
0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
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.
0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
You're still missing an End If ... be sure to use the new code I posted.
0
filtrationproductsAuthor Commented:
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
0
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Did you use the new code I posted? It contains the missing statement ...
0
filtrationproductsAuthor Commented:
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
0
filtrationproductsAuthor Commented:
I came across this posting;

http://www.access-programmers.co.uk/forums/showthread.php?t=203721

So I reprogrammed it using the API version and it works like it should.

http://access.mvps.org/access/api/api0001.htm

It now restricts the file name to excel format and prompts for overwrite even if the .XLS is not listed.

I had to create a module using the code on the second link then used this code to call and save the file.

Private Sub Command32_Click()

Dim mystrfilter As String

strFilter = ahtAddFilterItem(mystrfilter, "Excel Files (*.xls)", "*.xls")
strSaveFileName = ahtCommonFileOpenSave( _
                                    OpenFile:=False, _
                                    Filter:=strFilter, _
                    Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
                    
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "QRY_SearchAll2", strSaveFileName
                    
End Sub

Open in new window


Thanks for the help!
Dan
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
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
0
filtrationproductsAuthor Commented:
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
0
filtrationproductsAuthor Commented:
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
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.