With ActiveWorkbook.Connections("base table").ODBCConnection

Sub Макрос8()
'
' Макрос8 Макрос
'
'
    With ActiveWorkbook.Connections("base table").ODBCConnection
        .BackgroundQuery = False
        .CommandText = Array("SELECT * FROM `base`.`table`")
        .CommandType = xlCmdSql
        .Connection = "ODBC;DSN=alocal;"
        .RefreshOnFileOpen = False
        .SavePassword = False
        .SourceConnectionFile = _
        "C:\Users\admin\Documents\Мои источники данных\base table.odc"
        .SourceDataFile = ""
        .ServerCredentialsMethod = xlCredentialsMethodIntegrated
        .AlwaysUseConnectionFile = False
    End With
    With ActiveWorkbook.Connections("base table")
        .Name = "base table"
        .Description = ""
    End With
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:="ODBC;DSN=alocal;" _
        , Destination:=Range("$A$1")).QueryTable
'        .CommandType = 0
        .CommandText = Array("SELECT * FROM `base`.`table`")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .SourceConnectionFile = _
        "C:\Users\admin\Documents\Мои источники данных\base table.odc"
'        .ListObject.DisplayName = "Таблица_time_table"
        .Refresh BackgroundQuery:=False
    End With
End Sub

Dim fsT As Object 
savеMe= "D:\1.txt"
Set fsT = CreateObject("ADODB.Stream")
fsT.Type = 2 'Specify stream type - we want To save text/string data.
fsT.Charset = "utf-8" 'Specify charset For the source text data.
fsT.Open 'Open the stream And write binary data To the object
For Each i In Selection
fsT.WriteText i & vbCrLf
Next
fsT.SaveToFile savеMe, 2 'Save binary data To disk 

=ЛЕВСИМВ(A1;3)& "%" &ПСТР(A1;4;ДЛСТР(A1)-3)