Aranan Dosyaya Doğrudan Ulaşmak

[EKREM1661]

Değerli hocalarım..! (hayırlı çalışmalar dileğiyle)

Ekli dosyada.. Kopyalama yapılacak bir dosya, butondan konum ağacı takip edilerek bulunuyor.. Ancak, Kopyalama yapılacak dosya ile bu Excel dosyası aynı klasör içerisinde olacağı için.. Klasör hangi konuma taşınırsa taşınsın, arama yapmadan direk bulunduğu klasörü açsın.. Ne kadar revize yapmaya uğraştıysak olmadı..

 

[Ömer BARAN]

Merhaba.

Yanlış düşünmüyorsam, kulanılan kod'un baş kısmını aşağıdaki gibi değiştirdiğinizde istenilen gerçekleşir.
.

Private Sub CommandButton1_Click()
[COLOR="Red"]ChDrive ThisWorkbook.Path[/COLOR]
ChDir ThisWorkbook.Path & "\"
Kaynak = Application.GetOpenFilename(FileFilter:="Excel Dosyaları (*.XLSX), *.XLS", _
    MultiSelect:=False, Title:="Dosya Seçiniz ...")
If Kaynak = False Then
'.................

 

[EKREM1661]

Ömer hocam, oldu.. Ancak iki durum var.

1-Dosya C bölümünde ilken buluyor. Benim dosyam D bölümünde olduğu için bulamadı, direk belgelerim klasörünü açıyor.

2-Bir diğer sorun da, aranan dosya olarak YEDEKLEME dosyasını seçtiğimde, açılan formun sağ üst köşesindeki “x” dan iptal ettiğimde hata veriyor.

 

[Ömer BARAN]

.
Önceki cevabımı güncelledim.
Sayfayı yenileyerek kod'un yeni halini deneyiniz.
.

 

[EKREM1661]

Ömer hocam.. Yukarıda 3.mesajda belirttiğim her iki madde de bir değişiklik olmadı. Yoksa ben mi uyarlayamadım. İlk tıklamada D sürücüsünü bulamıyor. D sürücüsünü manuel seçip, formu kapatıp tekrar butona tıklayınca buluyor. Yani ilk önce D sürücüye manuel yönlendirme gerekiyor. Klasör şayet C konumundaysa sorun olmuyor.

 

[Ömer BARAN]

Tekrar merhaba.

Az önce; taşınabilir bellek üzerinden deneyebildim (benim hard disk bölümlenmiş değil).

Private Sub CommandButton1_Click() satırı ile ChDir satırının arasına
aşağıdaki satırı ekleyerek dener misiniz? (önceki cevabıma da ekledim)

Sanırım böyle sorun kalmayacak.

[COLOR="Red"]ChDrive ThisWorkbook.Path[/COLOR]

 

[Korhan Ayhan]

Alternatif;

Private Sub CommandButton1_Click()
    Konum = Split(ThisWorkbook.Path, Application.PathSeparator)(0) & Application.PathSeparator
    ChDrive (Konum)
    ChDir (ThisWorkbook.Path & "\")
    
    Kaynak = Application.GetOpenFilename("All Files (*.*),*.*.")
    If Kaynak = False Then
        MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
        Exit Sub
    End If
    
    Dosya = Dir(Kaynak)
    yer = Mid(Kaynak, 1, Len(Kaynak) - Len(Dir(Kaynak)))
    tmp = Dir(Kaynak)
    deg = "'" & yer & "[" & tmp & "]'!R"
    Cells(1, 1).Value = yer
    Cells(1, 2).Value = tmp
    On Error Resume Next
    Cells(1, 3).Value = "=" & deg & 1 & "C" & 1
    If Err = 1004 Then
        MsgBox "Yedekleme işleminin yapılacağı sayfayı seçmediğiniz için işleminiz iptal edilmiştir!", vbCritical
        Cells(1, 3).Value = ""
        Exit Sub
    End If
    Cells(1, 3).Replace What:="=", Replacement:=""
    alan1 = Worksheets(ActiveSheet.Name).Cells(1, 3).Value
    
    For k = 1 To Len(alan1)
        If Mid(alan1, k, 1) = "]" Then
            yer = (Len(alan1) - 6 - k)
            zaman = Mid(alan1, k + 1, yer)
        End If
    Next
    
    Cells(1, 3).Value = zaman
    sayfaadi = zaman
    deg = "'" & Kaynak & "\" & "[" & tmp & "]" & sayfaadi & "'!R"
    UserForm1.Show
End Sub

 

[EKREM1661]

Korhan hocam, çok harika olmuş ve çok teşekkür ediyorum. Bu sorunun çözümü uzun zamandan beri sıkıntı oluşturuyordu, konu kökten halledilmiş oldu.. Ömer hocam, ilgi ve yardımınız için size de teşekkürler.. Cümleten Hoşça kalınız..