SaveFileDialogBoxで上層フォルダがリネームできるようにするには？ (ID:101035)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

下記ファンクションを使用し、保存するのですが保存する場所にフォルダを作成しておきその中に保存させるよーにすると、実行されたフォームを閉じなければ作成されたフォルダをリネームしたり削除したりできません。

http://hp.vector.co.jp/authors/VA023539/tips/dialog/004.htm
このHPを参考にしているのですが、なにが足りないのかわかりません。

'↓処理部(Form1.Command1)
Private Sub Command1_Click()
Text1.Text = Module1.SaveFileDialogBox(Me.hWnd, "c:\", "*.*", "*.*")
End Sub

'↓モジュール部(Module1)
'<SaveFileDialogBox
Private Declare Function GetSaveFileName Lib "comdlg32.dll" _
    Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
    lStructSize       As Long    '構造体のサイズ
    hwndOwner         As Long    '親ウィンドウのハンドル
    hInstance         As Long    'モジュールのインスタンスハンドル
    lpstrFilter       As String  'VBのファイルパターン
    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    'フックプロシージャOFNHookprocへのポインタ
    lpTemplateName    As String  'テンプレートリソース名
End Type
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_EXPLORER = &H80000
Private strFileName   As String

Public Function SaveFileDialogBox(Ohwnd As Long, defaultDirectryPath As String, FilterName As String, Filter As String, Optional Title As String, Optional FileName As String, Optional SelectDir As String) As String '<2008_08_28
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
'名前を付けて保存ダイアログボックスを表示します。エラーやキャンセルの場合は"False"を返します。
'(例)MsgBox SaveFileDialogBox("xlsファイル","*.xls")->Xlsファイルを名前を付けて保存ダイアログボックスを表示し、値を格納します。
'\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Dim tOpenFileName As OPENFILENAME
Dim lngRet        As Long
With tOpenFileName
        .hwndOwner = Ohwnd '<2008_08_28
        '構造体のサイズを設定
        .lStructSize = Len(tOpenFileName)
        'ファイルパターンを設定（複数指定する場合は続いて記入）
        .lpstrFilter = FilterName & vbNullChar & Filter
        '優先的に表示させるフィルタのインデックス
        .nFilterIndex = 1
        'ファイル名の内容を初期化
            .lpstrFile = FileName & String$(256, Chr$(0))
        '同バイト数
            .nMaxFile = 256
        'ファイル名を受取るバッファの設定(Nullで埋めておく）
            .lpstrFileTitle = String$(256, Chr$(0))
        '同バイト数
            .nMaxFileTitle = 256
        'デフォルトのフォルダ名の設定
        .lpstrInitialDir = defaultDirectryPath
        
        'ダイアログのキャプション名
        If Title = "" Then
            .lpstrTitle = "名前を付けて保存"
        Else
            .lpstrTitle = Title
        End If
        'flagsの動作の設定
        .flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST Or _
         OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
End With
lngRet = GetSaveFileName(tOpenFileName)

If lngRet = 0 Then
    'キャンセルボタンを押した場合（クローズ・エラーも）
        SaveFileDialogBox = "False"
        Exit Function
Else
        SaveFileDialogBox = Left$(tOpenFileName.lpstrFile, InStr(tOpenFileName.lpstrFile, vbNullChar) - 1)
        seldir = ""
        Dim a As Integer '文字列の長さ
        Dim c As Integer '開始文字
        Dim d As String '検索された文字
        a = Len(SaveFileDialogBox)
        c = a - 1
        Do
            d = Mid(SaveFileDialogBox, c, 1)
            If "\" = d Then
                Exit Do
            End If
            c = c - 1
        Loop Until c < 1
        SelectDir = Mid(SaveFileDialogBox, 1, c)
End If
End Function

←解決時は質問者本人がここをチェックしてください。

戻る