Extraction auto querry

[chipriote]

Bonjour à tous,

Quelqu'un aurait-il une idée pour que ma macro attente la tin de l'extraction avant de reboucler sur le next i??

Sub Macro3()

For I = 2 To 20
a = Sheets("L24").Range("a" & I).Value
b = Sheets("L24").Range("b" & I).Value

Windows("ProDaily.xls").Activate
Windows("Extraction ProDaily etirable.xls").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=DIVALTO;UID=hyperion;PWD=hyperion;APP=Microsoft® Query;WSID=SRVTSE;DATABASE=DIVALTO" _
, Destination:=Range("t65000").End(xlUp).Offset(1, 0))
.CommandText = Array( _
"SELECT MOUV.CDNO, MOUV.REF, MOUV.MONT, MOUV.REFQTE" & Chr(13) & "" & Chr(10) & "FROM DIVALTO.dbo.ART ART, DIVALTO.dbo.ART ART_1, DIVALTO.dbo.ARTBIS ARTBIS, DIVALTO.dbo.BB BB, DIVALTO.dbo.CLI CLI, DIVALTO.dbo.ENT ENT, DIVALTO.dbo" _
, _
".MOUV MOUV, DIVALTO.dbo.MVTL MVTL" & Chr(13) & "" & Chr(10) & "WHERE CLI.TIERS = MOUV.TIERS AND MOUV.DOS = ART.DOS AND MOUV.REF = ART.REF AND MOUV.ENRNO = MVTL.ENRNO AND MOUV.CDNO = ENT.PINO AND MOUV.REF = ARTBIS.REF AND MOUV.SR" _
, _
"EF1 = ARTBIS.SREF1 AND ARTBIS.REF = BB.REF AND ARTBIS.SREF1 = BB.SREF1 AND BB.REFCO = ART_1.REF AND ((ENT.TICOD='C') AND (ENT.PICOD=2) AND (MOUV.CDNO=" & a & ") AND (MOUV.REF='00" & b & "'))" & Chr(13) & "" & Chr(10) & "ORDER BY MOUV.CDN" _
, "O")
.Name = "extraction commandes prod"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.Refresh BackgroundQuery:=True
End With
'Sleep (5000)
Next I

End Sub

Merci d'avance à vous

 

[chipriote]

Re : Extraction auto querry

Finallement j'ai trouvé si ca interesse quelqu'un:

Sub Macro3()
Dim objQT As QueryTable

For I = 2 To 20
On Error Resume Next
a = Sheets("L24").Range("a" & I).Value
b = Sheets("L24").Range("b" & I).Value

Windows("ProDaily.xls").Activate
Windows("Extraction ProDaily etirable.xls").Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=DIVALTO;UID=hyperion;PWD=hyperion;APP=Microsoft® Query;WSID=SRVTSE;DATABASE=DIVALTO" _
, Destination:=Range("t65000").End(xlUp).Offset(1, 0))
.CommandText = Array( _
"SELECT MOUV.CDNO, MOUV.REF, MOUV.MONT, MOUV.REFQTE" & Chr(13) & "" & Chr(10) & "FROM DIVALTO.dbo.ART ART, DIVALTO.dbo.ART ART_1, DIVALTO.dbo.ARTBIS ARTBIS, DIVALTO.dbo.BB BB, DIVALTO.dbo.CLI CLI, DIVALTO.dbo.ENT ENT, DIVALTO.dbo" _
, _
".MOUV MOUV, DIVALTO.dbo.MVTL MVTL" & Chr(13) & "" & Chr(10) & "WHERE CLI.TIERS = MOUV.TIERS AND MOUV.DOS = ART.DOS AND MOUV.REF = ART.REF AND MOUV.ENRNO = MVTL.ENRNO AND MOUV.CDNO = ENT.PINO AND MOUV.REF = ARTBIS.REF AND MOUV.SR" _
, _
"EF1 = ARTBIS.SREF1 AND ARTBIS.REF = BB.REF AND ARTBIS.SREF1 = BB.SREF1 AND BB.REFCO = ART_1.REF AND ((ENT.TICOD='C') AND (ENT.PICOD=2) AND (MOUV.CDNO=" & a & ") AND (MOUV.REF='00" & b & "'))" & Chr(13) & "" & Chr(10) & "ORDER BY MOUV.CDN" _
, "O")
.Name = "extraction commandes prod"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = True
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.Refresh BackgroundQuery:=False
End With

'Sleep (5000)
Next I
On Error GoTo 0
End Sub