Bonsoir à tous,
je me permet de venir vers vous pour une aide.
Je n'arrive pas à savior si le problème est dans Excel ou Sql.
j'ai un fichier excel avec cette VBA qui interroge notre serveur sql serveur 2017. (je suis repartie à 0 en essayant un autre code, mais toujours le problème)
En fait cela récupère une requete sql présent dans un fichier que voici:
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70 Sub try() 'Microsoft ActiveX Data Objects 6.1 Library Application.ScreenUpdating = False Worksheets("stockpr").[A3].CurrentRegion.ClearContents 'Configuration de la connexion Dim cnn As ADODB.Connection Set cnn = New ADODB.Connection 'Configuration de la methode de mise a jour (add/update/delete) Dim cmd As ADODB.Command Set cmd = New ADODB.Command 'Configuration du recorset pour l'affichage des resultats Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset Dim aa As Variant Dim myStringChange As String 'valeur de modification myStringChange = Range("A1").Value 'String de la connexion (ConnectionString est une methode de cnn) 'ici pas de login et mdp car authentification de sql server configuré en mode "authentification windows" 'DESKTOP-4XXXXXX\MONSQL - nom du serveur 'myDBB est la bdd choisie dans sql server cnn.ConnectionString = "Provider=SQLNCLI11;Server=.....................;" 'établissement de la connexion cnn.Open '************************************************* '*** AFFICHAGE DES RESULTATS DE LA MISE A JOUR *** '************************************************* 'curseur côté client, permet de compter le nombre de lignes dans le recordset 'si curseur côté serveur, renvoie -1 rs.CursorLocation = adUseClient 'requete d'affichage chemin = ActiveWorkbook.Path Set fso = CreateObject("Scripting.FileSystemObject") Const ForReading = 1, ForWriting = 2 Set f0000 = fso.OpenTextFile(chemin & "\stock-pr-mort-222-.txt", ForReading) une_variable0000 = f0000.ReadAll f0000.Close myQuery = une_variable0000 'enregistrement des resultats de la requete dans le recordset rs.Open myQuery, cnn ''on recopie les titres des colonnes For i = 0 To rs.Fields.Count - 1 Worksheets("stockpr").Cells(3, i + 1) = rs.Fields(i).Name Next i ''si une requête n'a pas de résultat, la transposition d'une string provoque une erreur, donc on place notre string dans un tablo If rs.RecordCount = 0 Then Dim tablo(1, 1) As Variant tablo(0, 0) = "No info available" aa = tablo MsgBox ("ok") Else MsgBox (rs.RecordCount) 'aa = rs.GetRows 'MsgBox (aa) End If
Le problème c'est que l’exécution du VBA ne se finit jamais, il reste toujours sur étape de l’exécution de la requête SQL.
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59 SELECT top 100 ltrim(trim(tgEmpresa.Razon)) AS societe, SUM(taHistorico.PrecioCosteMedio*(CASE WHEN taHistorico.StockFinal <= 0 THEN 0.00 ELSE COALESCE(taHistorico.StockFinal, 0.00) END)) AS valeur, SUM(CASE WHEN taHistorico.StockFinal <= 0 THEN 0.00 ELSE COALESCE(taHistorico.StockFinal, 0.00) END) AS qte, CASE WHEN dbo.fn_ICarDMS_dateDiff ('MONTH2',(COALESCE (dbo.fn_ICarDMS_GetLastHistMov ('002', taArticulo.NumInterno, '23/02/2021 00:00:00.000', 2), taArticuloalma.FechaAlta)) ,'23/02/2021 00:00:00.000') < 12 THEN 'vivant' WHEN dbo.fn_ICarDMS_dateDiff ('MONTH2',(COALESCE (dbo.fn_ICarDMS_GetLastHistMov ('002', taArticulo.NumInterno, '23/02/2021 00:00:00.000', 2), taArticuloalma.FechaAlta)) ,'23/02/2021 00:00:00.000') < 24 THEN 'dormant' ELSE 'mort' END AS Rango FROM taHistorico LEFT OUTER JOIN tgGrupoCont ON taHistorico.GrupoCont = tgGrupoCont.GrupoCont LEFT OUTER JOIN taFamProveedor ON taHistorico.Marca = taFamProveedor.Marca AND taHistorico.FamiliaProv = taFamProveedor.Codigo LEFT OUTER JOIN taFamInterna ON taHistorico.Marca = taFamInterna.Marca AND taHistorico.FamiliaInt = taFamInterna.Codigo LEFT OUTER JOIN taCategoriaStock ON taHistorico.Emp = taCategoriaStock.Emp AND taHistorico.Marca = taCategoriaStock.Marca AND taHistorico.CategoriaStock = taCategoriaStock.Codigo LEFT OUTER JOIN taclaseproducto ON taHistorico.Marca = taclaseproducto.Marca AND taHistorico.claseproducto = taclaseproducto.Codigo LEFT OUTER JOIN taCategoriaPieza ON taHistorico.Marca = taCategoriaPieza.Marca AND taHistorico.CodigoCategoria = taCategoriaPieza.Codigo, taArticuloAlma LEFT OUTER JOIN taArticuloPrecio ON (taArticuloAlma.NumInterno = taArticuloPrecio.NumInterno AND taArticuloAlma.Emp = taArticuloPrecio.Emp AND taArticuloAlma.Almacen = taArticuloPrecio.Almacen) , taArticulo LEFT OUTER JOIN taDctoCompra ON taArticulo.Marca = taDctoCompra.Marca AND taArticulo.Proveedor = taDctoCompra.Proveedor AND taArticulo.GrupoDctoCompra = taDctoCompra.GrupDctoComp AND taDctoCompra.TipoPedido IN (SELECT tipopedido FROM tgalma WHERE emp = '002' AND almacen = '20' ), tgEmpresa, tgAlma, tgMarca WHERE taArticuloAlma.Emp = '002' AND taArticuloAlma.Almacen = '20' AND taHistorico.Emp = taArticuloAlma.Emp AND taHistorico.Almacen = taArticuloAlma.Almacen AND taHistorico.NumIntArticulo = taArticuloAlma.NumInterno AND taHistorico.NumIntHistorico = dbo.fn_ICarDMS_LastHistArt ('002', '20', taArticuloAlma.NumInterno, '23/02/2021 00:00:00.000') AND taHistorico.StockFinal <> 0 AND taArticuloAlma.NumInterno = taArticulo.NumInterno AND taArticulo.EsConsigna = 0 AND taArticulo.NoAlmacenada = 0 AND taArticuloAlma.Emp = tgEmpresa.Emp AND taArticuloAlma.Emp = tgAlma.Emp AND taArticuloAlma.Almacen = tgAlma.Almacen AND taArticulo.Marca = tgMarca.Marca GROUP BY tgEmpresa.Razon, taArticulo.NumInterno, taArticuloalma.FechaAlta
- J'ai rajouté le timeout à 0 dans le VBA, >> j'ai été obligé de kill le fichier excel après 30 minutes exécution car il avait toujours pas fini (et sans erreur).
- si je copie et colle la requête dans SQL manager studio, elle s’exécute sans probleme (10 secondes).
- si je change ma requête pour avoir aucun résultat (je remplace le 20 par 30) ou bien par une autre requête simple, cela fonctionne la requête/vba se termine correctement.
je n'arrive pas a comprendre ou est le problème.
si quelqu'un pourrais m aiguiller sur des éléments à vérifier, je suis preneur
guigui69
Partager