Access2000のCommonDialogでファイル名を取得したい・・・

質問

Access2000でコモンダイアログBoxを使用してファイル名を取得
したいのですが、どうも上手く動きません！
取得方法を教えてください・・・

通常だと↓でText形式の保存。ではFile名は？

Dim strPath As String '指定ファイル名格納
'cdg = コモンダイアログ名
Me.cdg.Filter = "text|*.TXT"　
Me.cdg.FileName = "C:\*.txt"
'コモンダイアログボックス表示
Me.cdg.ShowOpen
strPath = "" & Me.cdg.FileName

回答No.3

TAGOSAKU7 · ベストアンサー

サンプルです。

エクセル2000にて動作確認しました。

求めているものと違ったらレスをください。

Private Const CSIDL_DESKTOP　　 As Long = &H0　　　 'デスクトップ フォルダ
Private Const CSIDL_PROGRAMS　　As Long = &H2　　　 'WINDOWS\プログラム フォルダ
Private Const CSIDL_CONTROLS　　As Long = &H3　　　 'コントロールパネル フォルダ
Private Const CSIDL_PRINTERS　　As Long = &H4　　　 'プリンタ フォルダ
Private Const CSIDL_PERSONAL　　As Long = &H5　　　 '共有フォルダ
Private Const CSIDL_FAVORITES　 As Long = &H6　　　 'お気に入り フォルダ
Private Const CSIDL_STARTUP　　 As Long = &H7　　　 'スタートアップ フォルダ
Private Const CSIDL_RECENT　　　As Long = &H8　　　 '最近使ったファイル フォルダ
Private Const CSIDL_SENDTO　　　As Long = &H9　　　 '送る フォルダ
Private Const CSIDL_BITBUCKET　 As Long = &HA　　　 'ごみ箱 フォルダ
Private Const CSIDL_STARTMENU　 As Long = &HB　　　 'スタートメニュ- フォルダ
Private Const CSIDL_DESKTOPDIRECTORY As Long = &H10 'WINDOWS\デスクトップ フォルダ
Private Const CSIDL_DRIVES　　　As Long = &H11　　　'マイコンピュータ フォルダ
Private Const CSIDL_NETWORK　　 As Long = &H12　　　'ネットワーク フォルダ
Private Const CSIDL_NETHOOD　　 As Long = &H13　　　'NETHOOD フォルダ
Private Const CSIDL_FONTS　　　 As Long = &H14　　　'フォント フォルダ
Private Const CSIDL_SHELLNEW　　As Long = &H15　　　'新規作成 フォルダ

Private Const BIF_RETURNONLYFSDIRS = &H1

Private Type BROWSEINFO
　　hWndOwner　　　 As Long
　　pidlRoot　　　　As Long
　　pszDisplayName　As String
　　lpszTitle　　　 As String
　　ulFlags　　　　 As Long
　　lpfn　　　　　　As Long
　　lParam　　　　　As Long
　　iImage　　　　　As Long
End Type

Private Declare Function SHBrowseForFolder Lib "SHELL32" (lpbi As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "SHELL32" (ByVal pIDL As Long, ByVal pszPath As String) As Long

Private Sub Main()
　　Dim strRtnValue As String
　　strRtnValue = ChoiceFolder("テスト")
　　If strRtnValue = "" Then
　　　　MsgBox "未選択"
　　Else
　　　　MsgBox strRtnValue
　　End If
End Sub

'フォルダの参照ダイアログ
'【パラメータ】ダイアログ解説文
Public Function ChoiceFolder(Optional inGuide As String = "フォルダを指定して下さい。") As String
　　Const MAX_PATH = 1000
　　Dim lngRetValue　　 As Long
　　Dim strPathBuffer　 As String * MAX_PATH
　　Dim udtBrowseInfo　 As BROWSEINFO
　　Dim ReturnPath　　　As String

　　strPathBuffer = String(MAX_PATH, vbNullChar)

　　With udtBrowseInfo
　　　　.pidlRoot = CSIDL_PROGRAMS　　　　　 'ルート フォルダ(CSIDL_xxx)
　　　　.lpszTitle = inGuide & vbNullChar　 'ダイアログの解説文
　　　　.ulFlags = BIF_RETURNONLYFSDIRS
　　End With

　　lngRetValue = SHBrowseForFolder(udtBrowseInfo)

　　If lngRetValue <> 0& Then
　　　　' パス名だけが返る
　　　　lngRetValue = SHGetPathFromIDList(lngRetValue, strPathBuffer)
　　　　If lngRetValue = 0 Then
　　　　　　' 無効なパス
　　　　　　ReturnPath = ""
　　　　Else
　　　　　　ReturnPath = Left(strPathBuffer, InStr(strPathBuffer, vbNullChar) - 1)
　　　　　　If Not (Right(ReturnPath, 1) = "\") Then ReturnPath = ReturnPath & "\"
　　　　End If
　　Else
　　　　'キャンセルされた
　　　　ReturnPath = ""
　　End If
　　ChoiceFolder = ReturnPath
End Function

お礼

解決しました！！
ありがとうございます。

回答No.2

TAGOSAKU7

なるほど、そういうことですか。

現在アクセスにコモンダイアログコントロールを使用してるという状況ですよね？
それではファイルの指定はできても、フォルダを指定させるダイアログを表示させることはできません。

フォルダ参照ダイアログにはＡＰＩが必要です。
現在ＶＢ環境が無いのですが、ＭＳ－Ｏｆｆｉｃｅはあるのでなんとかサンプルを載せることができそうです。

今はちと忙しいので、あとでサンプルを載せておきます。

お礼

ワザワザすみません！
お待ちしております。

回答No.1

TAGOSAKU7

>通常だと↓でText形式の保存

保存は
ShowOpenではなく
ShowSaveですよね？

strPath = "" & Me.cdg.FileName
MsgBox strPath
で確認したところ、strPathにはきちんとパスの文字列が帰ってきましたよ。。。

＞どうも上手く動きません
とは、ダイアログが表示されないのですか？
それともパスが取れないのですか？

なにがうまく動かないのか、もう一度説明してください。

補足

返答が送れてゴメンナサイ！
実はこの質問自体が間違ってます。
＞＞ダイアログボックスで特定のフォルダPathを取得したい。
と思っておりました。
回答がまったく無かった為、削除・修正も出来なく困っておりました。
そろそろ削除できるかと思い閲覧しました。
回答ありがとうございます。
もしよろしければご教授おねがい致します。