Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 394
  • Last Modified:

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

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
verdante
Asked:
verdante
  • 5
  • 3
1 Solution
 
cdmac2Commented:
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
 
rockiroadsCommented:
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
 
rockiroadsCommented:
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
Get 10% Off Your First Squarespace Website

Ready to showcase your work, publish content or promote your business online? With Squarespace’s award-winning templates and 24/7 customer service, getting started is simple. Head to Squarespace.com and use offer code ‘EXPERTS’ to get 10% off your first purchase.

 
verdanteAuthor Commented:
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
 
rockiroadsCommented:
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
 
verdanteAuthor Commented:
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
 
rockiroadsCommented:
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
 
verdanteAuthor Commented:
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
 
rockiroadsCommented:
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
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.

Join & Write a Comment

Featured Post

Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 5
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now