VBA 폴 더 탐색 대화 상자 에서 호출 하 는 몇 가지 방법

1.API 사용 방법 

'【 】
Private Type BROWSEINFO
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'【API 】
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, _
ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function lstrcat Lib "kernel32" _
Alias "lstrcatA" (ByVal lpString1 As String, _
ByVal lpString2 As String) As Long
Private Declare Function OleInitialize Lib "ole32.dll" _
(lp As Any) As Long
Private Declare Sub OleUninitialize Lib "ole32" ()
Private Const BIF_USENEWUI = &H40
Private Const MAX_PATH = 260
'【 】
Public Function GetFolder_API(sTitle As String, Optional vFlags As Variant) As String
Dim lpIDList As Long
Dim sBuffer As String
Dim BInfo As BROWSEINFO
If IsMissing(vFlags) Then vFlags = BIF_USENEWUI
Call OleInitialize(ByVal 0&)
With BInfo
.lpszTitle = lstrcat(sTitle, "")
.ulFlags = vFlags
End With
lpIDList = SHBrowseForFolder(BInfo)
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
If sBuffer <> "" Then GetFolder_API = sBuffer
End If
Call OleUninitialize
End Function
'【 】
Sub Test()
MsgBox GetFolder_API(" ")
End Sub
2、Shell.Application 사용 방법

Sub GetFloder_Shell()
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, " ", 0, 0)
If Not objFolder Is Nothing Then
MsgBox objFolder.self.path
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub
3、FileDialog 사용 방법

Sub GetFloder_FileDialog()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then MsgBox fd.SelectedItems(1)
Set fd = Nothing
End Sub
이상 WINXP+OFFICE 2003 에서 테스트 통과

좋은 웹페이지 즐겨찾기