Probleme multi connexion externe

bonjour a tous dans un fichier, j applique une macro d import de donnée externe pour actualiser des données filtrées dans une autre feuille

Dim t As Date

Sub importer()
Set wb = ThisWorkbook
   sPath = wb.Path & Application.PathSeparator
res = FileLen(wb.Path & Application.PathSeparator & "données.txt")
While res = 0
res = FileLen(wb.Path & Application.PathSeparator & "données.txt")
Wend
If Range("a2").Value = 0 Then
Application.ScreenUpdating = False

    Sheets("données").Select
    Range("B7:D7000").Select
    Selection.ClearContents
    Range("B7").Select
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & wb.Path & Application.PathSeparator & "données.txt", Destination:=Range("$A$7"))
        .Name = "données"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=True
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("recap").Select
    Range("B30").Select
    Application.ScreenUpdating = True
    t = Now + TimeValue("00:00:30")
    Application.OnTime t, "importer"

    End If
End Sub

le soucis est que cette macro se relance toute seule toute les 30 secondes, et si la connexion à déjà été faite 1 fois, il va nommée la nouvelle connexion donnée1, puis donnée2, etc...

et du coup a chaque renouvellement mon fichier prend du poid inutilement

comment lui dire que si la connexion n'existe pas il la créé, et que si elle existe déjà il l actualise

j utilise 4 variantes de cette macro, a partir du même fichier (qui aura été purgé au préalable, et a des endroits différents dans la feuille

    Dim t1 As Date, t2 As Date, t3 As Date, t4 As Date

Sub import2()

Set wb = ThisWorkbook
   sPath = wb.Path & Application.PathSeparator
res = FileLen(wb.Path & Application.PathSeparator & "données.txt")
While res = 0
res = FileLen(wb.Path & Application.PathSeparator & "données.txt")
Wend
If Sheets("recap").Range("a2").Value = 0 Then
Application.ScreenUpdating = False
    Sheets("données").Select
    Range("j7:l7000").Select
    Selection.ClearContents
    Range("j7").Select
 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & wb.Path & Application.PathSeparator & "données.txt", Destination:=Range("$i$7"))
        .Name = "données"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("recap").Select
    Range("B44").Select
    Application.ScreenUpdating = True
    t2 = Now + TimeValue("00:00:15")
        Application.OnTime t2, "import2"

    End If
End Sub

Sub import3()
'
Set wb = ThisWorkbook
   sPath = wb.Path & Application.PathSeparator
res = FileLen(wb.Path & Application.PathSeparator & "données.txt")
While res = 0
res = FileLen(wb.Path & Application.PathSeparator & "données.txt")
Wend
If Sheets("recap").Range("a2").Value = 0 Then
Application.ScreenUpdating = False
    Sheets("données").Select
    Range("r7:t7000").Select
    Selection.ClearContents
    Range("r7").Select
 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & wb.Path & Application.PathSeparator & "données.txt", Destination:=Range("$q$7"))
        .Name = "données"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("recap").Select
    Range("B58").Select
Application.ScreenUpdating = True
t3 = Now + TimeValue("00:00:15")
Application.OnTime t3, "import3"

    End If
End Sub
Sub import4()
'
' importer Macro
Set wb = ThisWorkbook
   sPath = wb.Path & Application.PathSeparator
res = FileLen(wb.Path & Application.PathSeparator & "données.txt")
While res = 0
res = FileLen(wb.Path & Application.PathSeparator & "données.txt")
Wend
If Sheets("recap").Range("a2").Value = 0 Then
Application.ScreenUpdating = False
    Sheets("données").Select
    Range("z7:ab7000").Select
    Selection.ClearContents
    Range("z7").Select
 With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & wb.Path & Application.PathSeparator & "données.txt", Destination:=Range("$y$7"))
        .Name = "données"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Cells.Select
    Cells.EntireColumn.AutoFit
    Sheets("recap").Select
    Range("B72").Select
    Application.ScreenUpdating = True
    t4 = Now + TimeValue("00:00:15")
        Application.OnTime t4, "import4"

    End If
End Sub

pour l instant j'essaye d effacer petit groupe par petit groupe les connexion afin de pas faire planter excel

personnes?

Rechercher des sujets similaires à "probleme multi connexion externe"