Office中国论坛/Access中国论坛

标题: [求助]导出目录 [打印本页]

作者: juliazj20 时间: 2005-2-28 21:29
标题: [求助]导出目录
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "ExportEmployee", "C:\Worksheet.xls", True

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

作者: 方漠 时间: 2005-2-28 22:27
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

作者: 方漠 时间: 2005-2-28 22:31
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 时间: 2005-3-1 01:08
我只用了 DoCmd.OutputTo acOutputQuery, "Your table / query", acFormatXLS, Sfn, True，而且将sfn留白，好了，成功了！

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)