Aynı Klasördeki Başka bir dosyayı diğer dosyadan çalıştırmak.

[ismail-34]

Çok Değerli Excel web ailesine selamlar..

Benim sorum çalıştığım dosya ile aynı klasörde olan Fişler adıyla başlayan bir başka dosyayı çalıştığım dosyadan çalıştırmak ile ilgili..

bunun için bir makro rica rica etcektim..

Saygılar sevgiler..

 

[ÖmerBey]

Merhaba,
Dosya yolunu kendinize göre uyarlayıp deneyiniz.

Sub kod()
dsy = "C:\Users\kullanici\Desktop\Fisler.xlsx"
Workbooks.Open dsy
End Sub

 

[ismail-34]

Merhaba,
Dosya yolunu kendinize göre uyarlayıp deneyiniz.

Sub kod()
dsy = "C:\Users\kullanici\Desktop\Fisler.xlsx"
Workbooks.Open dsy
End Sub

tam yer olarak değilde klasötler hep farklı yerlerde ve farklı isimlerde..mevcut klasör için bir çözüm yokmuydu..birde ismi fişler ile başlayan dosya için istemiştim yani fişler ahmet fişler mehmet bi sürü böyle dosya var..fişler den sonra başka isimler var yani..

 

[DoğanD]

Aşağıdaki gibi deneyebilirsiniz. isim değişkenine ahmet - mehmet neye ihtiyacınız varsa ekleyip kullanın.

Sub kod()
dsy = thisworkbook.path & "\Fisler" & isim & ".xlsx"
Workbooks.Open dsy
End Sub

 

[Korhan Ayhan]

Alternatif;

Benim sistemde Thisworkbook.Path farklı bir yol veriyor. Bu sebeple nette bulduğum bir fonksiyonu kullanmak zorunda kaldım...

ThisWorkbook.FullName returns a URL after syncing with OneDrive. I want the file path on disk

I have a workbook on OneDrive. Usually, ThisWorkbook.FullName returns a path on disk: c:\Users\MyName\OneDrive - MyCompany\BlaBla\MyWorkbook 09-21-17.xlsb But after a set of operation in VBA wher...

stackoverflow.com

Option Explicit

Sub File_Open()
    Dim File_Path As String, File_Name As String, File_Exists As String, WB As Workbook
    
    File_Path = Module1.GetLocalPath(ThisWorkbook.Path) & "\"
    File_Name = "Fişler"
    
    File_Exists = Dir(File_Path & File_Name & "*.xlsx")
    
    If File_Exists <> "" Then
        Set WB = Workbooks.Open(File_Path & File_Exists)
    Else
        MsgBox "Dosya bulunmadı!", vbCritical
    End If
End Sub

Public Function GetLocalPath(ByVal Path As String) As String
    Const HKCU = &H80000001
    Dim objReg As Object, rPath As String, subKeys(), subKey
    Dim urlNamespace As String, mountPoint As String, secPart As String
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\." & _
                           "\root\default:StdRegProv")
    rPath = "Software\SyncEngines\Providers\OneDrive\"
    objReg.EnumKey HKCU, rPath, subKeys
    For Each subKey In subKeys
        objReg.getStringValue HKCU, rPath & subKey, "UrlNamespace", urlNamespace
        If InStr(Path, urlNamespace) > 0 Then
            objReg.getStringValue HKCU, rPath & subKey, "MountPoint", mountPoint
            secPart = Replace(Mid(Path, Len(urlNamespace)), "/", "\")
            Path = mountPoint & secPart
            Do Until Dir(Path, vbDirectory) <> "" Or InStr(2, secPart, "\") = 0
                secPart = Mid(secPart, InStr(2, secPart, "\"))
                Path = mountPoint & secPart
            Loop
            Exit For
        End If
    Next
    GetLocalPath = Path
End Function

 

[ismail-34]

Alternatif;

Benim sistemde Thisworkbook.Path farklı bir yol veriyor. Bu sebeple nette bulduğum bir fonksiyonu kullanmak zorunda kaldım...

ThisWorkbook.FullName returns a URL after syncing with OneDrive. I want the file path on disk

I have a workbook on OneDrive. Usually, ThisWorkbook.FullName returns a path on disk: c:\Users\MyName\OneDrive - MyCompany\BlaBla\MyWorkbook 09-21-17.xlsb But after a set of operation in VBA wher...

stackoverflow.com

Option Explicit

Sub File_Open()
    Dim File_Path As String, File_Name As String, File_Exists As String, WB As Workbook
   
    File_Path = Module1.GetLocalPath(ThisWorkbook.Path) & "\"
    File_Name = "Fişler"
   
    File_Exists = Dir(File_Path & File_Name & "*.xlsx")
   
    If File_Exists <> "" Then
        Set WB = Workbooks.Open(File_Path & File_Exists)
    Else
        MsgBox "Dosya bulunmadı!", vbCritical
    End If
End Sub

Public Function GetLocalPath(ByVal Path As String) As String
    Const HKCU = &H80000001
    Dim objReg As Object, rPath As String, subKeys(), subKey
    Dim urlNamespace As String, mountPoint As String, secPart As String
    Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\." & _
                           "\root\default:StdRegProv")
    rPath = "Software\SyncEngines\Providers\OneDrive\"
    objReg.EnumKey HKCU, rPath, subKeys
    For Each subKey In subKeys
        objReg.getStringValue HKCU, rPath & subKey, "UrlNamespace", urlNamespace
        If InStr(Path, urlNamespace) > 0 Then
            objReg.getStringValue HKCU, rPath & subKey, "MountPoint", mountPoint
            secPart = Replace(Mid(Path, Len(urlNamespace)), "/", "\")
            Path = mountPoint & secPart
            Do Until Dir(Path, vbDirectory) <> "" Or InStr(2, secPart, "\") = 0
                secPart = Mid(secPart, InStr(2, secPart, "\"))
                Path = mountPoint & secPart
            Loop
            Exit For
        End If
    Next
    GetLocalPath = Path
End Function

Çok Değerli Korhan Hocam sizinkide olmadı malesef. Excel versiyonmu 2013 Türkçe
Çıkan hata için linkteki dosyayı kullanabilirsiniz..

İndir Fişler ile başlayan dosyayı çalıştır

Dosyayı indir Fişler ile başlayan dosyayı çalıştır

dosya.co

 

[Korhan Ayhan]

Mesajımda belirtmiştim. Thisworkbook.Path kodu bende Sharepoint ile ilgili bir yol bilgisi veriyor ve hatalı sonuç döndürüyordu. Bu sebeple fonksiyon kullanmak zorunda kaldım. Bu fonksiyon sizde sorun çıkarmış olabilir.

Siz aşağıdaki gibi deneyiniz.

Option Explicit

Sub File_Open()
    Dim File_Path As String, File_Name As String, File_Exists As String, WB As Workbook
   
    File_Path = ThisWorkbook.Path & "\"
    File_Name = "Fişler"
   
    File_Exists = Dir(File_Path & File_Name & "*.xlsm")
   
    If File_Exists <> "" Then
        Set WB = Workbooks.Open(File_Path & File_Exists)
    Else
        MsgBox "Dosya bulunmadı!", vbCritical
    End If
End Sub

 

[ismail-34]

Mesajımda belirtmiştim. Thisworkbook.Path kodu bende Sharepoint ile ilgili bir yol bilgisi veriyor ve hatalı sonuç döndürüyordu. Bu sebeple fonksiyon kullanmak zorunda kaldım. Bu fonksiyon sizde sorun çıkarmış olabilir.

Siz aşağıdaki gibi deneyiniz.

Option Explicit

Sub File_Open()
    Dim File_Path As String, File_Name As String, File_Exists As String, WB As Workbook
  
    File_Path = ThisWorkbook.Path & "\"
    File_Name = "Fişler"
  
    File_Exists = Dir(File_Path & File_Name & "*.xlsm")
  
    If File_Exists <> "" Then
        Set WB = Workbooks.Open(File_Path & File_Exists)
    Else
        MsgBox "Dosya bulunmadı!", vbCritical
    End If
End Sub

Haklısınız çok değerli hocam ben tüm kodu koymuşum özür dilerim. çok güzel çalışıyor sağolun varolun.