VisioのVBAでユーザにファイルを選択させる方法

質問

Visio 2003のVBAについてお伺いします。

ユーザに１または複数のファイルを選択させるためのダイアログを表示させたいのですが、どうやればよいのか分からなくて困っております。コマンドを教えて頂ければ幸いです。

ちなみに、VisioのVBAでは、ExcelにあるGetOpenFilenameコマンドがサポートされておりません。GetOpenFilenameコマンドと同様な機能を有するVisioのコマンドがあれば、それを教えてください。

よろしくお願い致します。

回答No.3

temtecomai2 · ベストアンサー

Office のライブラリーにあるダイアログも使えそうにないですね。
パッと確認してみましたが、Visio はダイアログ系が少ないですね。
であるならば、大昔からある手法でどうでしょうか。
GetOpenFileName という API を叩く方法です。

昔の VB 6.0 や Access 当たりではポピュラーな手法だったのでサンプルもたくさん転がっています。
http://www.google.com/search?hl=ja&lr=lang_ja&ie=UTF-8&oe=UTF-8&q=vba+%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB%E3%82%92%E9%96%8B%E3%81%8F+%E3%83%80%E3%82%A4%E3%82%A2%E3%83%AD%E3%82%B0+api&num=50

お礼

ありがとうございました！できました！
教えて頂いた方法は全く知りませんでした。VBAも奥が深いですね。

リンク先のサイトに載っていたものをVisioにあわせて修正したものをここに掲載しておきます。以下のコードは、CommandButton1を有するUserFormを作って、その中に書きます。

Option Explicit

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

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

Private Const OFN_ALLOWMULTISELECT = &H200

Private Sub CommandButton1_Click()
Dim Fkouzou As OPENFILENAME
Dim lngRet As Long, NULLPos As Long
Dim FileName As String

With Fkouzou
.flags = OFN_ALLOWMULTISELECT
.lStructSize = Len(Fkouzou)
.lpstrInitialDir = ThisDocument.Path
.lpstrFilter = "GIF(*.gif)" & vbNullChar & "*.gif"
.nMaxFile = 256
.lpstrFile = String(256, vbNullChar)

End With

lngRet = GetOpenFileName(Fkouzou)

If lngRet = 0 Then 、
MsgBox (vbNullString)
Else
MsgBox (Left(Fkouzou.lpstrFile, InStr(Fkouzou.lpstrFile, Chr(0)) - 1))
End If

End Sub

回答No.2

imogasi

もともとはＶＢＳ（ＷＳＨ）のもののようですが
Sub test01()
Set objDialog = CreateObject("UserAccounts.CommonDialog")
objDialog.Filter = "All Files|*.*"
objDialog.InitialDir = CurDir
intResult = objDialog.ShowOpen
If intResult = 0 Then
Wscript.Quit
Else
MsgBox objDialog.Filename
End If
End Sub
はエクセル標準モジュールでも動くようです。
ＶＩＳＩＯのＶＢＡでも動かないかやってみてください。
１つしか選択できないが、繰り返し選択させるではダメですか。
ＭｕｌｔｉＳｅｌｅｃｔはたぶんダメではないかと。
ーー
また、上記ＳＵＢ，Ｅｎｄ　Ｓｕｂを除いたものをメモ帳に貼り付け
拡張子.ＶＢＳでデスクトップに保存し、そのアイコンをダブルクリックしても、「ファイルを開く」ダイアロウグが出てきました。
私のどの環境が効いているのかわからないのですが。

補足

ご回答ありがとうございます。

Visioで試してみましたが、「ActiveXコンポーネントはオブジェクトを作成できません。」というメッセージが出て動きませんでした。ただ、Excel(バージョンは2007です。)でも同じメッセージが出て動きませんでした。拡張子.VBSでデスクトップに保存しても同様でした。

WSH特有のDLLか何かが必要ということでしょうか。ちなみに、VBはよく使っているのでインストールしていますが、WSHを含むVBSは使ったことがありません。

回答No.1

rivoisu

Visio VBAのことはわかりませんが
ExcelVBAでは
Application.FileDialog(msoFileDialogFilePicker)
でファイル選択をさせることができます。
使い方は下のコードを参照してください。
Sub ss()
Dim FLDname As String
Dim fname As String
FLDname = "e:\開発\vbs\" & Range("A2") & "*.vbs"
fname = ""
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = FLDname
.AllowMultiSelect = false
If .Show = True Then
fname = .SelectedItems(1)
End If
End With
Debug.Print fname
End Sub
複数ファイルの場合はAllowMultiSelect をTrueにして
SelectedItems()を配列で受けます。
あるのかなぁ

お礼

ご回答ありがとうございます。
しかしながら、FileDialogもVisioにはありません。
Visioに関してご回答頂ければ幸いです。