终于解决了：在vba中，使用api打开文件保存对话框

 苍天啊！

不容易啊！

几代人的心血，终于让我拼在一起了。

 

以下代码，请写入 标准模块中

在aceess 2007中测试通过。

希望，对大家有帮助

 

  Option Explicit
             
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private strfileStr     As String
Private Type OPENFILENAME
      lStructSize   As Long
      hWndOwner   As Long
      hInstance   As Long
      lpstrFilter   As String
      lpstrCustomFilter   As String
      nMaxCustFilter   As Long
      nFilterIndex   As Long
      lpstrFile   As String
      nMaxFile   As Long
      lpstrFileTitle   As String
      nMaxFileTitle   As Long
      lpstrInitialDir   As String
      lpstrTitle   As String
      flags   As Long
      nFileOffset   As Integer
      nFileExtension   As Integer
      lpstrDefExt   As String
      lCustData   As Long
      lpfnHook   As Long
      lpTemplateName   As String
End Type
 
Sub Main()
      Dim OpenFile     As OPENFILENAME
      Dim lReturn     As Long
      Dim sFilter     As String
     
      OpenFile.lStructSize = Len(OpenFile)
       
'      sFilter = "Excel   Files   (*.xls)" & Chr(0) & "*.xls" & Chr(0)
      sFilter = "文本文件 (*.TXT)" + Chr$(0) + "*.TXT" + Chr$(0) + "所有文件 (*.*)" + Chr$(0) + "*.*" + Chr$(0)
      OpenFile.lpstrFilter = sFilter
      OpenFile.nFilterIndex = 1
      OpenFile.lpstrFile = String(257, 0)
      OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
      OpenFile.lpstrFileTitle = OpenFile.lpstrFile
      OpenFile.nMaxFileTitle = OpenFile.nMaxFile
      OpenFile.lpstrInitialDir = ":/"
      OpenFile.lpstrTitle = "Use   the   Comdlg   API   not   the   OCX"
      OpenFile.flags = 0

'                  OpenFile.lpstrFile = "123.txt" & Space(254 - 6)   '--->文件名

      lReturn = GetOpenFileName(OpenFile)
      If lReturn = 0 Then
         MsgBox "The   User   pressed   the   Cancel   Button"
      Else
        strfileStr = Trim(TrimNullChar(OpenFile.lpstrFile)) & ".txt"
        MsgBox strfileStr
        Call outputFile(strfileStr)
      End If
End Sub

 

Private Function TrimNullChar(S As String) As String

    Dim i As Integer

    i = InStr(S, vbNullChar)

    If i > 0 Then

        TrimNullChar = Left(S, i - 1)

    Else

        TrimNullChar = S

    End If

End Function

 

Private Function outputFile(ByVal strAddr As String)
    Dim strLJ As String
    strLJ = strAddr
    MsgBox strLJ
    Open strLJ For Output As #1
        Print #1, "success!!!!"
    Close #1
End Function