Probleme multi connexion externe
v
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 Suble 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 Subpour l instant j'essaye d effacer petit groupe par petit groupe les connexion afin de pas faire planter excel