Soru Parent directory'e ulaşıp oradan farklı bir klasörü seçmek

[seckinb]

Merhaba

TRT dosyasının içinde Y90 ve LU177 diye 2 farklı klasör var. Bu klasörlerin her birinin içinde başka klasörler var.

Y90\AAA klasörünün içinde bulunan excel dosyasında iken commandbutton kullanarak LU177\ klasörünü görmek, onun içinden klasör - excel seçmek istiyorum.

normalde current directory'in alt klasörününü açarak veri almayı başarmıştım. Bu kodu nasıl modifiye edebilirim? teşekkürler

Sub dozimetri_al()
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set drive = FSO.GetDrive(FSO.GetDriveName(ThisWorkbook.FullName))
    ChDrive drive.DriveLetter
    ChDir ThisWorkbook.Path & "\dosya\"
    fName = Application.GetOpenFilename("Excel Files (*.xls?*), *.xls?", , "*")
    If fName = False Then Exit Sub

End Sub

" ChDir ThisWorkbook.Path & "\dosya\""

 

[Korhan Ayhan]

Deneyiniz.

Sub TEST()
    Dim Folders As Variant, Parent_Folder As String, Selected_Folder As Variant
    
    Folders = Split(ThisWorkbook.Path, "\")
    Parent_Folder = Folders(UBound(Folders) - 2)
    
    Set Selected_Folder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen klasör seçiniz.", 0, Parent_Folder & "\")
End Sub

 

[seckinb]

Deneyiniz.

Sub TEST()
    Dim Folders As Variant, Parent_Folder As String, Selected_Folder As Variant
   
    Folders = Split(ThisWorkbook.Path, "\")
    Parent_Folder = Folders(UBound(Folders) - 2)
   
    Set Selected_Folder = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen klasör seçiniz.", 0, Parent_Folder & "\")
End Sub

Parent klasörü açmadı, onun yerine bilgisayarım seçeneğini açtı.

 

[Haluk]

Aşağıdaki kodun olduğu Excel dosyasının konumu:

C:\Users\Haluk\Desktop\TRT\Y90\AAA\Test.xlsm

.

Sub Test()
'   Haluk - 02/01/2020
'   sa4truss@gmail.com
    Dim FSO As Object, FD As FileDialog

    Set FSO = CreateObject("Scripting.FileSystemObject")

    mainFolder = FSO.getFile(ThisWorkbook.FullName).parentFolder.parentFolder.parentFolder.Path

    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    With FD
        .Title = "Seçim yapın..."
        .AllowMultiSelect = False
        .InitialFileName = mainFolder
        .Filters.Add "Excel dosyaları", "*.xlsx; *.xlsm; *.xls; *.xlm", 1
        If .Show <> -1 Then Exit Sub
    End With

    myFile = FD.SelectedItems(1)

    MsgBox myFile
End Sub

Eğer; C:\Users\Haluk\Desktop\TRT\LU177 klasörünün içerisinden bir dosya seçecekseniz, kodda aşağıdaki değişikliği yapın...

    mainFolder = FSO.getFile(ThisWorkbook.FullName).parentfolder.parentfolder.parentfolder.Path & "\LU177"

.

 

[seckinb]

Aşağıdaki kodun olduğu Excel dosyasının konumu:

C:\Users\Haluk\Desktop\TRT\Y90\AAA\Test.xlsm

.

Sub Test()
'   Haluk - 02/01/2020
'   sa4truss@gmail.com
    Dim FSO As Object, FD As FileDialog

    Set FSO = CreateObject("Scripting.FileSystemObject")

    mainFolder = FSO.getFile(ThisWorkbook.FullName).parentFolder.parentFolder.parentFolder.Path

    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    With FD
        .Title = "Seçim yapın..."
        .AllowMultiSelect = False
        .InitialFileName = mainFolder
        .Filters.Add "Excel dosyaları", "*.xlsx; *.xlsm; *.xls; *.xlm", 1
        If .Show <> -1 Then Exit Sub
    End With

    myFile = FD.SelectedItems(1)

    MsgBox myFile
End Sub

Eğer; C:\Users\Haluk\Desktop\TRT\LU177 klasörünün içerisinden bir dosya seçecekseniz, kodda aşağıdaki değişikliği yapın...

    mainFolder = FSO.getFile(ThisWorkbook.FullName).parentfolder.parentfolder.parentfolder.Path & "\LU177"

.

Elinize sağlık,
Şimdi o adresteki veriyi buraya almak için kodumu modifiye edeceğim.

Birden fazla tedavi alan hastaların verisini birbirine aktarmak için kullanıyorum.

Teşekkürler ^^.