请教"另存为"功能

nagee

看了网上一些介绍,但有的需要引用Microsoft Office 11.0 Object Library,我的是XP没有Microsoft Office 11.0 Object Library,所以就自已定义(网上引用的)API,打开文件用

    Dim strFilter As String
    Dim lngFlags As Long, ctl As Control
    Dim db As Object
    Dim abcd As String
    strFilter = ahtAddFilterItem(strFilter, "(*.*)", "*.*")
    Me.DBBackRoad = ahtCommonFileOpenSave(InitialDir:=CurrentProject.Path , _
        Filter:=strFilter, FilterIndex:=3, flags:=lngFlags, _
        DialogTitle:="选择文件")


但不知道保存及另存为怎样写！

顺便问下！Microsoft Office 11.0 Object Library哪里可以下载注册！

nagee

模块定以如下：

Option Compare Database
Option Explicit

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 Type

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" (ofn As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (ofn As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Function 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 Variant
Dim 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 Function

Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String

    If IsMissing(varItem) Then varItem = "*.*"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function


Function TrimNull(ByVal strValue As String) As String
Dim intPos As Integer

intPos = InStr(strValue, vbNullChar)
Select Case intPos
  Case 0
    TrimNull = strValue
  Case 1
    TrimNull = ""
  Case Is > 1
    TrimNull = Left$(strValue, intPos - 1)
End Select

End Function

skylark

给一个不用Office11的,高手Fan0217的大作:





另外,现有Office2003遍地都是,Downlood重装你的Office不就Ok了,

否则以后还会有不便的时候!

nagee

这个例子!我也看了!但在我的机子上还没不能用"别存为"!错误代码为445!

nagee

还有一点!若是用2003做的程序!其兼容性怎么样?会不会在2000或XP上不能用!(只要是引用问题)

skylark

我将Fan0217的转成2000版的,你是否可用?

Office 11前有10  ,9 引用在我这儿无法试,你改成10或9试一下

nagee

还是不行呀! 我也试过不行的!我找不到"Office 11前有10  ,9 引用在我这儿无法试,你改成10或9试一下"

nagee

错误代码为445!

fyupeng

如何做的像windows那样的界面浏览文件