VB6 vs commandes DB2

Il faut ajouter une reference à cwbx.dll (il faut un "client acces" installé sur l'ordi)

Voici deux functions qui devraient faire ton affaire
Code:
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
 
Public Function Run(mvarSysteme As String, _
                    mvarUserId As String, _
                    mvarPassWord As String, _
                    mvarLibrary As String, _
                    mvarProgram As String, _
                    mvarParametres As String) As Boolean
  Dim As400 As New cwbx.AS400System
  Dim SystemName As New cwbx.SystemNames
  Dim Prog As New cwbx.Program
  Dim Params As New cwbx.ProgramParameters
  Dim Str2As400 As New cwbx.StringConverter
  Dim Erreur As cwbx.Error
  Dim Parametre As String
  Dim Tble As Variant
  Dim iPnt As Integer
  Dim Param As Variant
  As400.Define mvarSysteme
  On Error GoTo ErrHandler
  With Prog
    Set .System = As400
    .System.UserId = mvarUserId
    .System.PassWord = mvarPassWord
    .LibraryName = mvarLibrary
    .ProgramName = mvarProgram
    .System.Signon
    Tble = Split(mvarParametres, vbCrLf)
    For iPnt = 0 To UBound(Tble)
      Param = Split(Tble(iPnt), "|")
      If UBound(Param) = 1 Then
        Param(0) = Left(Param(0) & Space(Param(1)), Param(1))
        Params.Append "Par" & CStr(iPnt), cwbrcInput
        Params("Par" & CStr(iPnt)) = Str2As400.ToBytes(Param(0))
      End If
    Next
    .Call Params
    If .Errors.Count > 0 Then
      Run = False
    Else
      Run = True
    End If
  End With
Sortie:
  On Error GoTo 0
  Exit Function
ErrHandler:
  Run = False
  Err.Raise Err.Number, Err.Source, Err.Description
  Resume Sortie
End Function
 
Public Function RunCmd(mvarSysteme As String, _
                    mvarUserId As String, _
                    mvarPassWord As String, _
                    mvarProgram As String, _
                    mvarParametres As String) As Boolean
  Dim As400 As New cwbx.AS400System
  Dim SystemName As New cwbx.SystemNames
  Dim Cmd As New cwbx.Command
  Dim Str2As400 As New cwbx.StringConverter
  Dim Erreur As cwbx.Error
  Dim Parametre As String
  Dim Tble As Variant
  Dim iPnt As Integer
  Dim Param As Variant
  As400.Define mvarSysteme
  On Error GoTo ErrHandler
  With Cmd
    Set .System = As400
    .System.UserId = mvarUserId
    .System.PassWord = mvarPassWord
    .System.Signon
    .Run mvarProgram & " " & Replace(mvarParametres, vbCrLf, " ")
    If .Errors.Count > 0 Then
      RunCmd = False
    Else
      RunCmd = True
    End If
  End With
Sortie:
  On Error GoTo 0
  Exit Function
ErrHandler:
  RunCmd = False
  Err.Raise Err.Number, Err.Source, Err.Description
  Resume Sortie
End Function