[Tasos]

Καλημέρα Θανάση!

Θα πρότεινα τα εξής!
Δώσε σε ένα κελί οπουδήποτε στο βιβλίο εργασίας το όνομα "OldSrc" Μπορεί να είναι κρυφό ή βρίσκεται σε κρυμμένο φύλλο εργασίας. Δεν πρέπει να είναι κλειδωμένο.

Στην εντολή CreateQueryTable() πρόσθεσε στο τέλος τη γραμμή: Range("OldSrc").Value = ChoosenFile

Επίσης στην εντολή αυτή (στο προηγούμενο μου μήνυμα) μετέτρεψα την έκφραση:

tmpString = "ODBC;DSN=Excel Files;DBQ=" & MyConnectionString & ";DefaultDir=" & TheDir & _
                ";DriverId=790;MaxBufferSize=2048;PageTimeout=5;"

σε

tmpString = "ODBC;DSN=Excel Files;DBQ=" & ChoosenFile & ";DefaultDir=" & TheDir & _
                ";DriverId=790;MaxBufferSize=2048;PageTimeout=5;"

Για την αλλαγή πηγής δεδομένων με αντικατάσταση της διαδρομής του αρχείου στη σύνδεση ODBC και το κείμενο SQL τροποποίησα την εντολή SetQueryConnection() όπως φαίνεται παρακάτω:

Sub SetQueryConnection()
' Για να λειτουργήσει θα πρέπει το κελί "OldSrc" να περιέχει την διαδρομή προς αλλαγή.
' Ίσως την πρώτη φορά να χρειαστεί να συμπληρωθεί με το χέρι.
    Dim QT As QueryTable
    Dim TheDir As String
    Dim tmpString As String
    Dim MyConnectionString As Variant
    Dim MySQLString As Variant
    Dim ChoosenFile As Variant
    Dim fso As Object
    Dim ExtensionLen As Integer
    Dim ExtensionLenOld As Integer
    Dim OldSrc As String

    OldSrc = Range("OldSrc").Value

    ChoosenFile = Application.GetOpenFilename _
                  (Title:="Please choose source file", _
                   FileFilter:="Excel Files *.xls* (*.xls*),")

    If ChoosenFile = False Then
        MsgBox "No file selected.", vbExclamation, "!!!"
        Exit Sub
    ElseIf OldSrc = ChoosenFile Then
        MsgBox "There is already a data connection to this file!", vbInformation
        Exit Sub
    Else
        Set fso = CreateObject("Scripting.FileSystemObject")
        MsgBox "Source file will be:" & vbLf & ChoosenFile
    End If

    ExtensionLen = Len(fso.GetExtensionName(ChoosenFile)) + 1
    ExtensionLenOld = Len(fso.GetExtensionName(OldSrc)) + 1
    
    TheDir = fso.GetParentFolderName(ChoosenFile)

    Set QT = ActiveSheet.QueryTables(1)
       Debug.Print QT.CommandText
       Debug.Print QT.Connection
    tmpString = Replace(QT.CommandText, Left(OldSrc, Len(OldSrc) - ExtensionLenOld) _
                                       , Left(ChoosenFile, Len(ChoosenFile) - ExtensionLen))

    MySQLString = StringToArray(tmpString)

    tmpString = Replace(QT.Connection, OldSrc, ChoosenFile)
    
    QT.Connection = Array(MyConnectionString)
    QT.CommandType = xlCmdSql
    QT.CommandText = Array(MySQLString)

    QT.Refresh BackgroundQuery:=False
    
    Range("OldSrc").Value = ChoosenFile
    
End Sub

Καλή συνέχεια!

Τάσος