Excel Vba Forum - Excelce.Net
SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: düşünceli - 25 Ekim 2020, 19:33:49
-
Selamlar. Sayın Bülent ÖZTÜRK beyin aşağıda ki linkte bulunan kodunda Klasör seçilerek Klasör yolunu mesaj olarak vermektedir.
Benim talebim ise Aynı kodla alınan klasör yolunun userform üzerinde labele almaktır. Bu mümkün müdür?
Bülent Beyin konusu:
http://www.excelce.net/forum/index.php?topic=315.msg1088#msg1088 :utandim
Bülent Beyin paylaştığı kodları: :utandim
Public Type BROWSEINFO
hOwner 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
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Sub KlasorAciklama()
MsgBox KlasorYolu("Bir Klasör seçiniz:")
End Sub
Function KlasorYolu(Optional msg) As String
Dim bInfo As BROWSEINFO
Dim Path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(msg) Then
bInfo.lpszTitle = "Bir Klasör seçiniz."
Else
bInfo.lpszTitle = msg
End If
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
Path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal Path)
If r Then
pos = InStr(Path, Chr$(0))
KlasorYolu = Left(Path, pos - 1)
Else
MsgBox "Klasör seçilmedi!", vbExclamation, "Excelce.Net"
End
End If
End Function
-
Merhaba Emine hanım,
Hoş geldiniz.
Şu şekilde daha pratik:
Sub klasor_adi_ve_yolu()
Dim objFolder, objShell
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Klasor seciniz", 1, "")
If Not (objFolder Is Nothing) Then
Label1.caption= "Klasor adi: " & objFolder.Title
Label2.caption="Tam yolu: " & objFolder.Self.Path
End If
End Sub