[求助]导出目录

juliazj20

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ExportEmployee", "C:\Worksheet.xls", True

请问，"C:\Worksheet.xls"能否是一个变量，在用户导出数据时，会有一个象windows里一样，可以选择目录的一个窗口？

方漠

Here it is:Private Sub Command178_Click()

Dim Sfn As String

Dim StrFilter As String

Dim lngFlags As Long



On Error GoTo Err_Command178_Click

    StrFilter = ahtAddFilterItem(StrFilter, "Excel Files(*.xls)", "*.xls")

   

    Sfn = ahtCommonFileOpenSave(InitialDir:="C:\", _

        Filter:=StrFilter, FilterIndex:=3, Flags:=lngFlags, _

        DialogTitle:="输出数据", hwnd:=Application.hWndAccessApp, OpenFile:=False)If Len(Trim(Sfn)) = 0 Then Exit SubDoCmd.OutputTo acOutputQuery, "Your table / query", acFormatXLS, Sfn, TrueExit_Command178_Click:

    Exit SubErr_Command178_Click:

    MsgBox Err.Description

    Resume Exit_Command178_Click

End Sub

方漠

Sorry!仲有一个模块，需要COPY到你的模块中，说实话，这方法不太好。

Option Compare Database

Public Sfn As String

Type tagOPENFILENAME

    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 TypeDeclare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _

    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As BooleanDeclare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _

    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As LongGlobal Const ahtOFN_READONLY = &H1

Global Const ahtOFN_OVERWRITEPROMPT = &H2

Global Const ahtOFN_HIDEREADONLY = &H4

Global Const ahtOFN_NOCHANGEDIR = &H8

Global Const ahtOFN_SHOWHELP = &H10

Global Const ahtOFN_NOVALIDATE = &H100

Global Const ahtOFN_ALLOWMULTISELECT = &H200

Global Const ahtOFN_EXTENSIONDIFFERENT = &H400

Global Const ahtOFN_PATHMUSTEXIST = &H800

Global Const ahtOFN_FILEMUSTEXIST = &H1000

Global Const ahtOFN_CREATEPROMPT = &H2000

Global Const ahtOFN_SHAREAWARE = &H4000

Global Const ahtOFN_NOREADONLYRETURN = &H8000

Global Const ahtOFN_NOTESTFILECREATE = &H10000

Global Const ahtOFN_NONETWORKBUTTON = &H20000

Global Const ahtOFN_NOLONGNAMES = &H40000

Global Const ahtOFN_EXPLORER = &H80000

Global Const ahtOFN_NODEREFERENCELINKS = &H100000

Global Const ahtOFN_LONGNAMES = &H200000Function ahtCommonFileOpenSave( _

            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 VariantDim OFN As tagOPENFILENAME

Dim strFileName As String

Dim strFileTitle As String

Dim fResult As Boolean

  

    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



    strFileName = Left(fileName & String(256, 0), 256)

    strFileTitle = String(256, 0)    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

      

        .lpfnHook = 0

   

        .strCustomFilter = String(255, 0)

        .nMaxCustFilter = 255

    End With

  

    If OpenFile Then

        fResult = aht_apiGetOpenFileName(OFN)

    Else

        fResult = aht_apiGetSaveFileName(OFN)

    End If  

    If fResult Then

        

        If Not IsMissing(Flags) Then Flags = OFN.Flags

        ahtCommonFileOpenSave = TrimNull(OFN.strFile)

    Else

        ahtCommonFileOpenSave = vbNullString

    End If

End FunctionFunction ahtAddFilterItem(StrFilter As String, _

    st

juliazj20

我只用了 DoCmd.OutputTo acOutputQuery, "Your table / query", acFormatXLS, Sfn, True，而且将sfn留白，好了，成功了！