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 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
| '******************************************************
' Met à jour SAP avec les lignes de suivi en KO ou OK_C
'******************************************************
Function rfc_maintain_table(w_system As String) As Integer
' Pour le master on charge tous
' Pour les autres systèmes on ne charge que les données du système
Dim R3, MyFunc, App As Object
Dim AUDIT, Rque, ENTRIES As Object
Dim rs, rs2, system As DAO.Recordset
Dim Result As Boolean
Dim Export1 As Object
Dim Export2 As Object
Dim Export3 As Object
Dim pos As Integer
Dim cpt As Integer
Dim valeur As Variant
Dim ligne As Variant
Const taille_ligne As Integer = 100
Set system = CurrentDb.TableDefs("systemes").OpenRecordset(dbOpenSnapshot, dbReadOnly)
system.FindFirst "system = '" & w_system & "'"
'Create Server object and Setup the connection
Set R3 = CreateObject("SAP.Functions")
R3.Connection.system = Nz(system!system)
R3.Connection.HostName = Nz(system!HostName)
R3.Connection.SystemNumber = Nz(system!SystemNumber)
R3.Connection.client = Nz(system!client)
R3.Connection.User = Nz(system!User)
R3.Connection.Password = Nz(system!Password)
R3.Connection.language = Nz(system!language)
If R3.Connection.logon(0, True) <> True Then
MsgBox "Erreur de connexion à " & system!system, vbOKOnly
system.Close
Exit Function
End If
'Call RFC function RFC_CALL_TRANSACTION
Set MyFunc = R3.Add("Z_AUDIT_MAINTAIN")
On Error Resume Next
Set AUDIT = MyFunc.Tables("AUDIT")
Set Rque = MyFunc.Tables("RQUE")
If Err.Number = 91 Then
On Error GoTo 0
MsgBox "Fonction Z_AUDIT_MAINTAIN n'existe pas sur " & Nz(system!system)
R3.Connection.LOGOFF
Exit Function
End If
system.Close
On Error GoTo 0
' Recordset des lignes de suivi en KO ou OK_C
Set rs = CurrentDb.OpenRecordset("select * from suivi where " & IIf(w_system = CurrentDb.Properties("Master"), "", "syst ='" & w_system & "' and ") & "not isnull(auditdate)")
If rs.RecordCount = 0 Then Exit Function
' Recordset des champs à extraire vers SAP
Set rs2 = CurrentDb.OpenRecordset("extract_sap_audits")
rs.MoveFirst
While Not rs.EOF
AUDIT.rows.Add
rs2.MoveFirst
While Not rs2.EOF
valeur = rs.Fields(rs2!champs).Value
If Not IsNull(valeur) And valeur <> "" And valeur <> " " Then
' Gestion des remarques
If Left(rs2!champs, 4) = "rque" Then
valeur = Replace(valeur, Chr(10), "") 'Vire les retours chariots
cpt = 1
Do
' Recherche les sauts de ligne
pos = InStr(1, valeur, Chr(13))
If pos = 0 Then
ligne = valeur
Else
ligne = Left(valeur, pos - 1)
valeur = Right(valeur, Len(valeur) - pos)
End If
' Split les lignes suivant taille_ligne
If Len(ligne) > taille_ligne Then
Do
Rque.rows.Add
Rque.Value(Rque.rows.Count, "SYST") = rs!syst
Rque.Value(Rque.rows.Count, "TRKORR") = rs!trkorr
Rque.Value(Rque.rows.Count, "OBJECT") = rs!object
Rque.Value(Rque.rows.Count, "OBJ_NAME") = rs!obj_name
Rque.Value(Rque.rows.Count, "NUM") = cpt
Rque.Value(Rque.rows.Count, "TEXTE") = Left(ligne, taille_ligne)
Rque.Value(Rque.rows.Count, "TYPE") = UCase(rs.Fields(rs2!champs).Name)
If Len(ligne) <= taille_ligne Then Exit Do
cpt = cpt + 1
ligne = Right(ligne, Len(ligne) - taille_ligne)
Loop
Else
Rque.rows.Add
Rque.Value(Rque.rows.Count, "SYST") = rs!syst
Rque.Value(Rque.rows.Count, "TRKORR") = rs!trkorr
Rque.Value(Rque.rows.Count, "OBJECT") = rs!object
Rque.Value(Rque.rows.Count, "OBJ_NAME") = rs!obj_name
Rque.Value(Rque.rows.Count, "NUM") = cpt
Rque.Value(Rque.rows.Count, "TEXTE") = ligne
Rque.Value(Rque.rows.Count, "TYPE") = UCase(rs.Fields(rs2!champs).Name)
End If
If pos = 0 Then Exit Do
cpt = cpt + 1
Loop
Else
AUDIT.Value(AUDIT.rows.Count, rs.Fields(rs2!champs).Name) = Trim(valeur)
End If
End If
rs2.MoveNext
Wend
rs.MoveNext
Wend
rs.Close
rs2.Close
Result = MyFunc.Call
If Result = True Then
Set ENTRIES = MyFunc.Imports("ENTRIES")
rfc_maintain_table = ENTRIES
Else
MsgBox MyFunc.EXCEPTION
R3.Connection.LOGOFF
Exit Function
End If
'Quit the SAP Application
R3.Connection.LOGOFF
End Function |
Partager