web-dev-qa-db-ja.com

ファイルパスの取得（フォルダーで終わる）

ユーザーがボタンをクリックして、特定のファイルに移動して開く方法を知っています。

コード：

Private Sub CommandButton2_Click()
    Dim vaFiles As Variant

    vaFiles = Application.GetOpenFilename()

    ActiveSheet.Range("B9") = vaFiles
End Sub

ユーザーがプログラムに作成する.pdfファイルを保存するフォルダーに移動できるようにする2番目のボタンが必要です。

問題：GetOpenFilenameでは、ユーザーがファイルをクリックする必要があります。フォルダにファイルがなければ、ユーザーができることは何もありません。

excelvbafile-io
11
Jesse Smothermon

使用 Application.FileDialogオブジェクト

Sub SelectFolder()
    Dim diaFolder As FileDialog
    Dim selected As Boolean

    ' Open the file dialog
    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    selected = diaFolder.Show

    If selected Then
        MsgBox diaFolder.SelectedItems(1)
    End If

    Set diaFolder = Nothing
End Sub
24
chris neilsen

ユーザーがフォルダーを選択する代わりにキャンセルボタンを押す場合に備えて、これにErrorHandlerを追加しました。そのため、恐ろしいエラーメッセージを取得する代わりに、フォルダを選択する必要があるというメッセージが表示され、ルーチンが終了します。以下のコードは、フォルダ名を範囲名で保存します（シート上のセルA1にリンクされているだけです）。

Sub SelectFolder()

Dim diaFolder As FileDialog

'Open the file dialog
On Error GoTo ErrorHandler
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.Title = "Select a folder then hit OK"
diaFolder.Show
Range("IC_Files_Path").Value = diaFolder.SelectedItems(1)
Set diaFolder = Nothing
Exit Sub

ErrorHandler:
Msg = "No folder selected, you must select a folder for program to run"
Style = vbError
Title = "Need to Select Folder"
Response = MsgBox(Msg, Style, Title)

End Sub
5
Derek

VBAエディターの[ツール]メニューで、[参照...]をクリックし、[Microsoft Shell Controls And Automation]まで下にスクロールして選択します。

Sub FolderSelection()
    Dim MyPath As String
    MyPath = SelectFolder("Select Folder", "")
    If Len(MyPath) Then
        MsgBox MyPath
    Else
        MsgBox "Cancel was pressed"
    End If
End Sub

'Both arguements are optional. The first is the dialog caption and
'the second is is to specify the top-most visible folder in the
'hierarchy. The default is "My Computer."

Function SelectFolder(Optional Title As String, Optional TopFolder _
                         As String) As String
    Dim objShell As New Shell32.Shell
    Dim objFolder As Shell32.Folder

'If you use 16384 instead of 1 on the next line,
'files are also displayed
    Set objFolder = objShell.BrowseForFolder _
                            (0, Title, 1, TopFolder)
    If Not objFolder Is Nothing Then
        SelectFolder = objFolder.Items.Item.Path
    End If
End Function

ソースリンク 。

2
ray

デフォルトでフォルダを参照する場合：たとえば、「D：\ Default_Folder」は「InitialFileName」属性を初期化します。

Dim diaFolder As FileDialog

' Open the file dialog
Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
diaFolder.AllowMultiSelect = False
diaFolder.InitialFileName = "D:\Default_Folder"
diaFolder.Show
1
Lah Ezcen

Application.GetSaveAsFilename()を使用したのと同じ方法でApplication.GetOpenFilename()を使用します

1
jonsca

これはあなたを助けるかもしれません：

Sub SelectFolder()
    Dim diaFolder As FileDialog
    Dim Fname As String

    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    diaFolder.AllowMultiSelect = False
    diaFolder.Show

    Fname = diaFolder.SelectedItems(1)

    ActiveSheet.Range("B9") = Fname

End Sub
0
Bhagwat Singh