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
|
Private Declare PtrSafe Function GetEnvironmentVariable Lib "kernel32" _
Alias "GetEnvironmentVariableA" _
(ByVal lpName As String, _
ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Function GetEnvironmentVar(Name As String) As String
GetEnvironmentVar = String(255, 0)
GetEnvironmentVariable Name, GetEnvironmentVar, Len(GetEnvironmentVar)
GetEnvironmentVar = TrimNull(GetEnvironmentVar)
End Function
Private Function TrimNull(item As String)
Dim iPos As Long
iPos = InStr(item, vbNullChar)
TrimNull = IIf(iPos > 0, Left$(item, iPos - 1), item)
End Function
Sub majref()
SqlQuery = Array("SELECT M.idate , M.nom, M.nomjf, M.prenom, M.sexe, M.datenaiss, M.age, M.datej , M.heure , U.ref , U.result from MULTICOL M, URGRES U where M.idate = U.ippdate and u.ref = 'INJPED' and m.datej >= to_date('04/10/2023 00:00:00', 'dd-mm-yyyy hh24:mi:ss') and m.datej <= trunc(SYSDATE) and trunc(MONTHS_BETWEEN(SYSDATE, TO_DATE(m.datenaiss, 'DD/MM/YYYY'))) <= 18")
Sheets("Beyfortus").Select
'supprimer ancien contenu
['Beyfortus'!A1:z1000].ClearContents
' /* ************************************ */
' ************* Driver ODBC *************
' /* ************************************ */
Application.Workbooks.Open ("\\srv-apps\scripts\prod\prod_odbc.xls"), ReadOnly:=True
Application.Run ("prod_odbc.xls!Module1.urqprododbc")
Workbooks("prod_odbc.xls").Close
conn = GetEnvironmentVar("URQUAL")
Range("A1").Select
With Selection.QueryTable
.Connection = conn
.CommandText = SqlQuery ' <---- l'erreur 13 est ici
End With
'Mise à jour des valeurs
Range("A1").Select
Selection.QueryTable.Refresh BackgroundQuery:=False |
Partager