Dosya Seçip Alma ve Seçtiğim Dosyanın Adresini Bulma

[emsey]

Değerli arkadaşlar.
Aşağıdaki kodlar ile daha önce dosya seçip açıyordum ancak şuanda buna paralel olarak ayrı bir makroda dosyayı açmadan seçtiğim dosyanın adresini adres = "" şeklinde set etmeye bulmaya ihtiyacım var. Kodun neresini değiştirmem gerekiyor. Ben her ihtimale karşı örnek dosyada ekledim. Yardımcı olabilir misiniz?

 Application.DisplayAlerts = False
  Application.ScreenUpdating = False
 
  yol = ThisWorkbook.Path & "\"
 
  ChDrive yol
  ChDir yol
  MsgBox ("Dosya seçiniz seçiniz")
  If Application.Dialogs(xlDialogOpen).Show("*.xlsm?") = False Then Exit Sub
  acikhesapdosyasi = ActiveWorkbook.Name
 
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True

 

[yusuf1284]

Sub DosyaAc()
    Dim adres As String
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    adres = Application.GetOpenFilename("Excel Dosyaları (*.xlsm), *.xlsm")
    If adres = False Then Exit Sub
    
    Workbooks.Open adres
    acikhesapdosyasi = ActiveWorkbook.Name
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Örnek amaçlı attım

 

[emsey]

Sub DosyaAc()
    Dim adres As String
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
   
    adres = Application.GetOpenFilename("Excel Dosyaları (*.xlsm), *.xlsm")
    If adres = False Then Exit Sub
   
    Workbooks.Open adres
    acikhesapdosyasi = ActiveWorkbook.Name
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Örnek amaçlı attım

Tamam istediğim bu gibi ancak üstad şöyle bir sıkıntı var. Açılan pencerede seçtiğim dosyanın adresini almak istiyorum. Dosyayı hiç açmayacağım bu makroda . Başka makroda dosyayı açtırma ile ilgili çözdüm. Bu makroda aslında dosyanın yolunu dosyanın adı ve uzantısını almak için dosyayı gözat ile seçtirmek istiyorum. Bu seçtiği dosya benim excel kodlarda çalışacağım adres olacak. Sürekli dosyanın yeri değişebiliyor her seferinde kodu değiştirmek zor oluyor

 

[Haluk]

Sub Test()
'   Haluk - 29/03/2023
    Set objShell = CreateObject("Shell.Application")
    Set objFile = objShell.BrowseForFolder(0, "Dosya seçin...", 512 + 16384)
    If (Not objFile Is Nothing) Then
        MsgBox objFile.Self.Path
    End If
End Sub

.

 

[emsey]

Harika gerçekten Adamın dibisin üstat. Teşekkür ederim. Emeği geçen cevap veren tüm arkadaşlara teşekkürler Allah razı olsun.

Yalnız konuya paralel bir soru soracağım. Kodda çıkan Gözat penceresi eski windows tipinde çıkıyor. Windows 7-10-11 gibi ve Excel versiyonlarında veya 32-64 bit olaylarında sıkıntı yaşatır mı acaba?

ub Test() ' Haluk - 29/03/2023 Set objShell = CreateObject("Shell.Application") Set objFile = objShell.BrowseForFolder(0, "Dosya seçin...", 512 + 16384) If (

 

[Haluk]

64 Bit ile hazırlamıştım, 32 Bit ile de hiç bir sorun çıkartmaz....

.