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

Başlık: Klasör yolu seçerek Labele yazdırmak.
Gönderen: 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

Başlık: Ynt: Klasör yolu seçerek Labele yazdırmak.
Gönderen: Bülent Öztürk - 31 Ekim 2020, 09:44:27
Merhaba Emine hanım,
Hoş geldiniz.

Şu şekilde daha pratik:

Kod: [Seç]
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