Veri-Bağlantıları Düzenle

[emre8456]

Arkadaşlar Merhaba
Veri-Bağlantıları düzenle - dosya seç işlemini makro ile yapmak mümkün mü ? örnek; mevcut dosyamın bağlantıları işletme(01.11.2025).xlsx dosyası ile bağlı. Ben bu bağlantıyı işletme(02.11.2025).xlsx dosyası ile güncellemek istiyorum.
her sabah dosya tarihleri değişiyor

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kod işinize yarayabilir..

Option Explicit

Sub Change_Links_File()
    Dim File_Links As Variant, X As Long, Link As String
    
    File_Links = ThisWorkbook.LinkSources(xlExcelLinks)
    
    If IsEmpty(File_Links) Then
        MsgBox "Bağlantı bulunamadı.", vbExclamation
        Exit Sub
    End If
    
    For X = LBound(File_Links) To UBound(File_Links)
        Link = File_Links(X)
        If MsgBox("Bu bağlantıyı değiştirmek ister misiniz?" & vbCrLf & Link, vbYesNo) = vbYes Then
            Application.Dialogs(xlDialogChangeLink).Show Link, Link
        End If
    Next
End Sub

 

[emre8456]

Merhaba,

Aşağıdaki kod işinize yarayabilir..

Option Explicit

Sub Change_Links_File()
    Dim File_Links As Variant, X As Long, Link As String
   
    File_Links = ThisWorkbook.LinkSources(xlExcelLinks)
   
    If IsEmpty(File_Links) Then
        MsgBox "Bağlantı bulunamadı.", vbExclamation
        Exit Sub
    End If
   
    For X = LBound(File_Links) To UBound(File_Links)
        Link = File_Links(X)
        If MsgBox("Bu bağlantıyı değiştirmek ister misiniz?" & vbCrLf & Link, vbYesNo) = vbYes Then
            Application.Dialogs(xlDialogChangeLink).Show Link, Link
        End If
    Next
End Sub

Korhan Bey kusura bakmayın mesajınızı yeni gördüm Teşekkür ederim. dialog penceresi açıldı. Bağlanacak dosya ismnide makroda belirtirsek otomatik olarak bağlantıyı yapamazmıyız ?

 

[Korhan Ayhan]

Bu kodu deneyiniz.

Option Explicit

Sub Change_Links_File()
    Dim File_Links As Variant
    Dim X As Long
    Dim Old_Link As String
    Dim Folder_Path As String
    Dim New_File_Name As String
    Dim New_Link As String
   
    File_Links = ThisWorkbook.LinkSources(xlExcelLinks)
   
    If IsEmpty(File_Links) Then
        MsgBox "Bağlantı bulunamadı.", vbExclamation
        Exit Sub
    End If
   
    For X = LBound(File_Links) To UBound(File_Links)
        Old_Link = File_Links(X)
        Folder_Path = Left(Old_Link, InStrRev(Old_Link, "\"))
       
        New_File_Name = InputBox("Bağlantıyı güncellemek için sadece yeni dosya adını giriniz..." & vbCrLf & vbCrLf & _
                                 "Örnek ; Kitap1.xlsx" & vbCrLf & vbCrLf & vbCrLf & _
                                 "Bağlantı Yolu ; " & Old_Link, "Bağlantı Güncelle", "")
       
        If Trim(New_File_Name) <> "" Then
            New_Link = Folder_Path & New_File_Name
           
            ThisWorkbook.ChangeLink Name:=Old_Link, NewName:=New_Link, Type:=xlLinkTypeExcelLinks
           
            MsgBox "Bağlantı değiştirildi:" & vbCrLf & _
                   "Eski: " & Old_Link & vbCrLf & _
                   "Yeni: " & New_Link, vbInformation
        Else
            MsgBox "Bu bağlantı için işlem yapılmadı.", vbInformation
        End If
    Next
End Sub

 

[emre8456]

Bu kodu deneyiniz.

Option Explicit

Sub Change_Links_File()
    Dim File_Links As Variant
    Dim X As Long
    Dim Old_Link As String
    Dim Folder_Path As String
    Dim New_File_Name As String
    Dim New_Link As String
  
    File_Links = ThisWorkbook.LinkSources(xlExcelLinks)
  
    If IsEmpty(File_Links) Then
        MsgBox "Bağlantı bulunamadı.", vbExclamation
        Exit Sub
    End If
  
    For X = LBound(File_Links) To UBound(File_Links)
        Old_Link = File_Links(X)
        Folder_Path = Left(Old_Link, InStrRev(Old_Link, "\"))
      
        New_File_Name = InputBox("Bağlantıyı güncellemek için sadece yeni dosya adını giriniz..." & vbCrLf & vbCrLf & _
                                 "Örnek ; Kitap1.xlsx" & vbCrLf & vbCrLf & vbCrLf & _
                                 "Bağlantı Yolu ; " & Old_Link, "Bağlantı Güncelle", "")
      
        If Trim(New_File_Name) <> "" Then
            New_Link = Folder_Path & New_File_Name
          
            ThisWorkbook.ChangeLink Name:=Old_Link, NewName:=New_Link, Type:=xlLinkTypeExcelLinks
          
            MsgBox "Bağlantı değiştirildi:" & vbCrLf & _
                   "Eski: " & Old_Link & vbCrLf & _
                   "Yeni: " & New_Link, vbInformation
        Else
            MsgBox "Bu bağlantı için işlem yapılmadı.", vbInformation
        End If
    Next
End Sub

Korhan Bey Teşekkür ederim. Sizden bir ricam daha olacak. Bu kodları bağlantısı güncellenecek dosyada değil de bağımsız bir dosyadan çalıştırmak için nasıl düzenlenmek gerek. Yani bağlantı yapılacak ve bağlantısı güncellenecek dosyaları bağımsız bir dosyadan bir birine bağlamalıyım

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Change_Links_File()
    Dim File_Links As Variant
    Dim Links_List() As String, New_Link As String
    Dim Old_File As String, New_File As String
    Dim Links_WorkBook As Workbook, X As Long
    
    Old_File = Application.GetOpenFilename("Excel Dosyaları (*.xls*),*.xls*", , _
                                           "Bağlantıları Güncellenecek Dosyayı Seçiniz...")
    If Old_File = "False" Then
        MsgBox "İşlem iptal edildi.", vbExclamation
        Exit Sub
    End If
    
    New_File = Application.GetOpenFilename("Excel Dosyaları (*.xls*),*.xls*", , _
                                           "Yeni dosyayı seçin (bağlantılar buna yönlendirilecek)")
    If New_File = "False" Then
        MsgBox "İşlem iptal edildi.", vbExclamation
        Exit Sub
    End If
    
    Set Links_WorkBook = Workbooks.Open(Old_File, False, False)
    
    File_Links = Links_WorkBook.LinkSources(xlExcelLinks)
    
    If IsEmpty(File_Links) Then
        MsgBox "Bu çalışma kitabında güncellenecek bağlantı bulunamadı.", vbExclamation
        Exit Sub
    End If
    
    ReDim Links_List(LBound(File_Links) To UBound(File_Links))
    
    For X = LBound(File_Links) To UBound(File_Links)
        Links_List(X) = File_Links(X)
    Next
    
    For X = LBound(Links_List) To UBound(Links_List)
        If MsgBox("Aşağıdaki bağlantıyı değiştirmek ister misiniz?" & vbCrLf & vbCrLf & _
                   "Eski: " & Links_List(X) & vbCrLf & vbCrLf & _
                   "Yeni: " & New_File, vbYesNo + vbCritical + vbDefaultButton2) = vbYes Then
            Links_WorkBook.ChangeLink Name:=Links_List(X), NewName:=New_File, Type:=xlLinkTypeExcelLinks
        End If
    Next
    
    Erase File_Links
    Erase Links_List
    Old_File = ""
    New_File = ""
    
    Links_WorkBook.Close 1
    
    Set Links_WorkBook = Nothing
    
    MsgBox "Tüm uygun bağlantılar güncellendi.", vbInformation
End Sub