Solved

Call Common Dialog File Save As to save Excel file from MS Access 2003

Posted on 2006-06-18
9
370 Views
Last Modified: 2012-05-05
Hi

I have an Access Project which I will be distributing with runtime Access. I have a control on a form from which I want to invoke the Common Dialogue Save As feature to allow the user to save an Excel file in the location of their choice. What't the best way to proceed?

cheers

Verdy
0
Comment
Question by:verdante
  • 5
  • 3
9 Comments
 
LVL 1

Expert Comment

by:cdmac2
ID: 16931700
I used this code to SaveAs in an Excel program, but I beleive it should work for access too.

        Application.Dialogs(xlDialogSaveAs).Show

-MikeMc
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16931885
Add this code into a module


Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strfile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Declare Function pksGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As OPENFILENAME) As Boolean
Declare Function pksGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OFN As OPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const OFN_READONLY = &H1
Global Const OFN_OVERWRITEPROMPT = &H2
Global Const OFN_HIDEREADONLY = &H4
Global Const OFN_NOCHANGEDIR = &H8
Global Const OFN_SHOWHELP = &H10
Global Const OFN_ENABLEHOOK = &H20
Global Const OFN_ENABLETEMPLATE = &H40
Global Const OFN_ENABLETEMPLATEHANDLE = &H80
Global Const OFN_NOVALIDATE = &H100
Global Const OFN_ALLOWMULTISELECT = &H200
Global Const OFN_EXTENSIONDIFFERENT = &H400
Global Const OFN_PATHMUSTEXIST = &H800
Global Const OFN_FILEMUSTEXIST = &H1000
Global Const OFN_CREATEPROMPT = &H2000
Global Const OFN_SHAREAWARE = &H4000
Global Const OFN_NOREADONLYRETURN = &H8000
Global Const OFN_NOTESTFILECREATE = &H10000
Global Const OFN_NONETWORKBUTTON = &H20000
Global Const OFN_NOLONGNAMES = &H40000
Global Const OFN_EXPLORER = &H80000
Global Const OFN_NODEREFERENCELINKS = &H100000
Global Const OFN_LONGNAMES = &H200000


Function GetOpenFile(Optional varDirectory As Variant, Optional varTitleForDialog As Variant) As Variant
   
    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant
   
    lngFlags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_NOCHANGEDIR
   
    If IsMissing(varDirectory) Then
        varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then varTitleForDialog = ""
   
    strFilter = AddFilterItem(strFilter, "Access (*.mdb)", "*.MDB;*.MDA")
    varFileName = CreateDialog(OpenFile:=True, InitialDir:=varDirectory, filter:=strFilter, Flags:=lngFlags, DialogTitle:=varTitleForDialog)
   
    If Not IsNull(varFileName) Then varFileName = TrimNull(varFileName)
   
    GetOpenFile = varFileName
End Function

Function CreateDialog( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal filename As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hWnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant

    Dim OFN As OPENFILENAME
    Dim strFileName As String
    Dim strFileTitle As String
    Dim fResult As Boolean
    Dim sFiles() As String
    Dim i As Integer
    Dim sSelectedItem As String
    Dim sDrive As String


    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(filter) Then filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(filename) Then filename = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hWnd) Then hWnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
   
    ' Allocate string space for the returned strings.
    strFileName = Left(filename & String(256, 0), 256)
    strFileTitle = String(256, 0)
   
    ' Set up the data structure before you call the function
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hWnd
        .strFilter = filter
        .nFilterIndex = FilterIndex
        .strfile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        .hInstance = 0
        .strCustomFilter = ""
        .nMaxCustFilter = 0
        .lpfnHook = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With

    If OpenFile Then
        fResult = pksGetOpenFileName(OFN)
    Else
        fResult = pksGetSaveFileName(OFN)
    End If

    If fResult Then
        If Not IsMissing(Flags) Then Flags = OFN.Flags
       
        sSelectedItem = Replace(OFN.strfile, vbNullChar, ";")
        Debug.Print OFN.strfile
        sFiles = Split(sSelectedItem, ";")
       
        If Left(sFiles(0), 2) = "\\" Then
            If GetAttr(sFiles(0)) And vbDirectory = True Then
                CreateDialog = sFiles(0)
                Exit Function
            End If
       
        ElseIf Right(sFiles(0), 2) <> ":\" Then
            CreateDialog = sFiles(0)
            Exit Function
        End If
       
        CreateDialog = ""
       
        sDrive = sFiles(0)
        If Right$(sDrive, 1) <> "\" Then sDrive = sDrive & "\"
       
        For i = LBound(sFiles) + 1 To UBound(sFiles)
            If sFiles(i) <> vbNullChar And Trim$(sFiles(i)) <> "" Then
                If CreateDialog <> "" Then CreateDialog = CreateDialog & ";"
                CreateDialog = CreateDialog & sDrive & sFiles(i)
            End If
        Next i
       
        If CreateDialog = "" And OFN.strfile <> "" Then CreateDialog = OFN.strfile
    Else
        CreateDialog = "NoFile"
    End If
End Function

Function AddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String
    If IsMissing(varItem) Then varItem = "*.*"
    AddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String

    Dim intPos As Integer
   
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16931887
Now use it like this

    Dim sFile As String
    Dim sPath As String
   
    Dim sFilter As String
    Dim lFlags As Long

    On Error Resume Next
   
    sFilter = AddFilterItem(sFilter, "Text Files(*.tx)", "*.txt")
   
    sFile = CreateDialog(InitialDir:="sFilter", _
                        filter:=sFilter, FilterIndex:=1, Flags:=OFN_EXPLORER, _
                        DialogTitle:="Save As File", _
                        OpenFile:=False)
                       
                   
    MsgBox "You picked " & sFile & " to save to "
   
0
 

Author Comment

by:verdante
ID: 16931920
Thanks rockiroads

When I run the code I get an error Ambiguous Name Selected:Split

When I debug I get dropped here:

        sFiles = Split(sSelectedItem, ";")

Sorry I'm being lazy so I haven't had a good look through the code but I've just realised (and this may not be relevant) that while I have attached the code to a control on my form, I haven't specified which object I want to save as an Excel spreadsheet. It is the query attached to the form if that helps
cheers
Verdy
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 65

Expert Comment

by:rockiroads
ID: 16931959
Have you a module called Split? or another function called split?
Split is a reserved word which is why I ask

All the code should ideally be placed in a module, except for the calling code, which can be put into a form i.e.

Dim sFile As String
    Dim sPath As String
   
    Dim sFilter As String
    Dim lFlags As Long

    On Error Resume Next
   
    sFilter = AddFilterItem(sFilter, "Excel Files (*.xls)", "*.xls")
   
    sFile = CreateDialog(InitialDir:="sFilter", _
                        filter:=sFilter, FilterIndex:=1, Flags:=OFN_EXPLORER, _
                        DialogTitle:="Save As File", _
                        OpenFile:=False)
                       
                   
    MsgBox "You picked " & sFile & " to save to "


When u run this, u get prompted for a filename, u can pick an existing or new file
If u have a bounded form, simply set your field to be sFile

0
 

Author Comment

by:verdante
ID: 16933549
Rockiroads, great call. It rung a bell and I looked through an old module which used Split. Wasn't using the module any more so I deleted it.

Now the code executes bug free and I get the confirming msgbox at the end but the filename I enter  doesn't appear to save anywhere.  I'm still unclear how the code is picking up the name of the query attached to the form. Can you please explain that part so I can test it?

cheers

Verdy

PS I've upped the score to 500
0
 
LVL 65

Accepted Solution

by:
rockiroads earned 500 total points
ID: 16934670
ok, this code produces a dialog and returns the selected filename
it is then up to you want u want to do with it

U say u want to save an Excel file, how is this file produced, is it via execution of a query?


did u know, if all u want to do is run a query and output the results, u can do this

DoCmd.OutputTo acOutputQuery, "myquery", acFormatXLS


this will then automatically prompt you for a filename

0
 

Author Comment

by:verdante
ID: 16939928
Thanks rockiroads. That command works exactly as I had hoped and the points are yours. Sorry to take you up a blind alley with the earlier attempt at solution,
cheers
Verdy
0
 
LVL 65

Expert Comment

by:rockiroads
ID: 16940099
No probs. Always best for you to understand first.
I don't see the point in answers being taken and used without actually understanding it!
0

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Regardless of which version on MS Access you are using, one of the harder data-entry forms to create is one where most data from previous entries needs to be appended to new records, especially when there are numerous fields and records involved.  W…
Experts-Exchange is a great place to come for help with solutions for your database issues, and many problems are resolved within minutes of being posted.  Others take a little more time and effort and often providing a sample database is very helpf…
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now