none
Access2010(64)でのGetSaveFileName(comdlg32.dll)使用方法 RRS feed

  • 質問

  • Access2010、windows7で動作させる為に、

    元々あった32bit dll呼び出しソースに対し、システム条件分岐修正を行いました。

    Access2010、windows7で動作させたところ、

    "ファイルを保存する"ダイアログが表示されません。(後ろに隠れているわけでもなさそう)

    本来であれば「intRet = GetSaveFileName(of)」の部分でダイアログが表示されると思うのですが・・・

    原因、対応方法が分からない状態です、ご教授いただけませんでしょうか。

    '「ファイルを開く」用
    #If VBA7 Then
      Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
      Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
     
      Type OPENFILENAME
            lStructSize As Long
            hwndOwner As LongPtr
            hInstance As LongPtr
            lpstrFilter As String
            lpstrCustomFilter As String
            nMaxCustrFilter 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
            lCustrData As LongPtr
            lpfnHook As LongPtr
            lpTemplateName As String
      '#if (_WIN32_WINNT >= 0x0500)
              pvReserved As LongPtr
              dwReserved As Long
              FlagsEx As Long
      '#endif // (_WIN32_WINNT >= 0x0500)
      End Type
    #Else
      Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
      Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

      Private Type OPENFILENAME
          lStructSize As Long
          hwndOwner As Long
          hInstance As Long
          lpstrFilter As String
          lpstrCustomFilter As Long
          nMaxCustrFilter 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
          lCustrData As Long
          lpfnHook As Long
          lpTemplateName As Long
      End Type
    #End If

    Private Const OFN_FILEMUSTEXIST = &H1000
    Private Const OFN_HIDEREADONLY = &H4
    Private Const OFN_READONLY = &H1
    Private Const OFN_OVERWRITEPROMPT = &H2
    Private Const ALLFILES = "All Files"

    Private Type MSA_OPENFILENAME
        ' [ファイルを開く] ダイアログ フィルタに使用するフィルタ文字列。
        ' これを開くには、MSA_CreateFilterString() を使用します。
        ' 既定値は すべてのファイル, *.*。
        strFilter As String
        ' 表示するフィルタの初期値。
        ' 既定値は 1。
        lngFilterIndex As Long
        ' ダイアログに表示される初期ディレクトリ名。
        ' 既定値は、カレント ディレクトリ。
        strInitialDir As String
        ' ダイアログに表示される初期ファイル名。
        ' 既定値は、""。
        strInitialFile As String
        strDialogTitle As String
        ' 拡張子が指定されなかった場合にファイルに追加する既定の拡張子。
        ' 既定値は、システム値です。
        strDefaultExtension As String
        ' フラグ。
        ' 既定値は、フラグなし。
        lngFlags As Long
        ' 選択されたファイルのフル パス。  ダイアログでユーザーが拡張子のないファイルを選択すると、
        ' [ファイル名] ボックスのテキストだけが返されます。
        strFullPathReturned As String
        ' 選択されたファイルの名前。
        strFileNameReturned As String
        ' フルパス (strFullPathReturned) のファイル名の開始を示すオフセット。
        intFileOffset As Integer
        ' フルパス (strFullPathReturned) のファイルの拡張子の開始を示すオフセット。
        intFileExtension As Integer
    End Type

     

    '参照ボタンから呼び出すもの
    Public Function GetExcelFileName(strSearchPath, strTitle, strMode As String) As String
       
        Dim msaof As MSA_OPENFILENAME
       
        ' ダイアログ ボックスのオプションを設定します。
        msaof.strDialogTitle = strTitle
        msaof.strInitialDir = strSearchPath
        msaof.strFilter = MSA_CreateFilterString("Microsoft Excel ブック (*.xls)", "*.xls")
       
        If strMode = "R" Or strMode = "r" Then
          ' [ファイルを取込む] ダイアログ ボックスのルーチンを呼び出します。
          msaof.lngFlags = msaof.lngFlags Or OFN_FILEMUSTEXIST
          MSA_GetOpenFileName msaof
        ElseIf strMode = "W" Or strMode = "w" Then
          ' [名前を付けて保存] ダイアログ ボックスのルーチンを呼び出します。
          msaof.lngFlags = msaof.lngFlags Or OFN_OVERWRITEPROMPT
          MSA_GetSaveFileName msaof
        Else
          GetExcelFileName = ""
          Exit Function
        End If
       
        ' パスとファイル名を返します。
        GetExcelFileName = Trim(msaof.strFullPathReturned)
       
    End Function

     

    Private Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
    ' 渡された引数からフィルタ文字列を作成します。
    ' 引数として何も渡されなかった場合は、長さ 0 の文字列 ("") を返します。
    ' 引数が遇数個渡された場合、それに *.* を追加します。
       
        Dim strFilter As String
        Dim intRet As Integer
        Dim intNum As Integer

        intNum = UBound(varFilt)
        If (intNum <> -1) Then
            For intRet = 0 To intNum
                strFilter = strFilter & varFilt(intRet) & vbNullChar
            Next
            If intNum Mod 2 = 0 Then
                strFilter = strFilter & "*.*" & vbNullChar
            End If
           
            strFilter = strFilter & vbNullChar
        Else
            strFilter = ""
        End If
       
        MSA_CreateFilterString = strFilter
    End Function


    Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
    ' 名前を付けて保存ダイアログ ボックスを開きます。
       
        Dim of As OPENFILENAME
        Dim intRet As Integer

        MSAOF_to_OF msaof, of
        of.flags = of.flags Or OFN_HIDEREADONLY
        intRet = GetSaveFileName(of)
        If intRet Then
            OF_to_MSAOF of, msaof
        End If
        MSA_GetSaveFileName = intRet
    End Function

    Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
    ' このプロシージャは、win32 構造体を MSAccess 構造体に変換します。
       
        msaof.strFullPathReturned = Left$(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
        msaof.strFileNameReturned = of.lpstrFileTitle
        msaof.intFileOffset = of.nFileOffset
        msaof.intFileExtension = of.nFileExtension
    End Sub

    Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
    ' このプロシージャは、MSAccess 構造体を win32 構造体に変換します。
       
        Dim strFile As String * 512

        ' 構造体の一部を初期化します。
        of.hwndOwner = Application.hWndAccessApp
        of.hInstance = 0
        of.lpstrCustomFilter = 0
        of.nMaxCustrFilter = 0
        of.lpfnHook = 0
        of.lpTemplateName = 0
        of.lCustrData = 0
       
        If msaof.strFilter = "" Then
            of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
        Else
            of.lpstrFilter = msaof.strFilter
        End If
        of.nFilterIndex = msaof.lngFilterIndex
       
        of.lpstrFile = msaof.strInitialFile & String$(512 - Len(msaof.strInitialFile), 0)
        of.nMaxFile = 511

        of.lpstrFileTitle = String$(512, 0)
        of.nMaxFileTitle = 511

        of.lpstrTitle = msaof.strDialogTitle

        of.lpstrInitialDir = msaof.strInitialDir
       
        of.lpstrDefExt = msaof.strDefaultExtension

        of.flags = msaof.lngFlags
       
        of.lStructSize = Len(of)
    End Sub

    2013年6月28日 2:02

回答

  • もう大分時間が経っているので、解決されているかと思いますが、

    おそらく、

    of.lStructSize = Len(of)

    をVBA7のときは

    of.lStructSize = LenB(of)

    にすればよいかと思います。

    • 回答としてマーク xxxxxyz 2013年12月20日 6:44
    2013年8月1日 16:22
  • 私も同じ現象に悩まされましたが、解決しました。

    lpstrCustomFilterのゼロクリアをやめたらうまくいきました。
    MSAOF_to_OFの中でやっています。
    (Win8 x64 + Office2013 x64で確認)

    ちなみに
    http://www.jkp-ads.com/articles/apideclarations.asp
    で見つけたものと、GetOpenFileNameに渡す変数を比較していて見つけました。

    ずいぶん時間が空いてしまいましたが、後から見つけた人にもわかるといいと思い書き込みしておきます。

    • 回答としてマーク xxxxxyz 2013年12月20日 6:44
    2013年9月27日 0:04

すべての返信

  • もう大分時間が経っているので、解決されているかと思いますが、

    おそらく、

    of.lStructSize = Len(of)

    をVBA7のときは

    of.lStructSize = LenB(of)

    にすればよいかと思います。

    • 回答としてマーク xxxxxyz 2013年12月20日 6:44
    2013年8月1日 16:22
  • 私も同じ現象に悩まされましたが、解決しました。

    lpstrCustomFilterのゼロクリアをやめたらうまくいきました。
    MSAOF_to_OFの中でやっています。
    (Win8 x64 + Office2013 x64で確認)

    ちなみに
    http://www.jkp-ads.com/articles/apideclarations.asp
    で見つけたものと、GetOpenFileNameに渡す変数を比較していて見つけました。

    ずいぶん時間が空いてしまいましたが、後から見つけた人にもわかるといいと思い書き込みしておきます。

    • 回答としてマーク xxxxxyz 2013年12月20日 6:44
    2013年9月27日 0:04
  • 別方法で実装しましたが、

    回答としてマークさせていただきます

    2013年12月20日 6:44