VBA connexion ODBC

Version imprimable

VBA connexion ODBC

Bonjour,

voila mon problème. J'ai créé une macro qui à partir d'un code article saisi dans une cellule, se connecte via une source de données ODBC à l'as400 (driver iseries access) afin de récupérer le libellé correspondant au code article.

La source de données est créée sur le poste client via le panneau de configuration->outils d'administration... (source de données système)

Pourtant lorsque je teste la macro.

Sur mon poste, la réponse s'affiche immédiatement idem sur celui de mon collègue
Sur le poste d'une autre collègue : affichage boite de dialogue pour sélectionner la source de données

Alors que les paramètres sont les mêmes
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 With ActiveSheet.QueryTables.Add(Connection:="ODBC;DSN=FICHIER_ARTICLES;", _ Destination:=Range("B" & ligne_courante)) .CommandText = Array( _ "SELECT MVXAWRKQU9.FGETLIBART(100,'" & Range("A" & ligne_courante).Value & "')AS TEST FROM MVXAWRKQU9.ZZPSVID") .Name = "REQUETE LIBELLE ARTICLE" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlOverwriteCells .SavePassword = True .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .Refresh BackgroundQuery:=True End With
Avez-vous une idée d'ou le problème peut venir? Merci d'avance.

Olivier

Bonjour,

les joies des connexions ODBC :mouarf:
Je me rappelle avoir pas mal ramé pour réussir a faire marcher correctment la connection.

Voila le bout de code dont je me sert pour me connecter et exécuter des requetes :

Code:

1
2
3
4
5
6
7
8
9
 
Set oconn = New ADODB.connection
oconn.Open "Driver={Microsoft Visual FoxPro Driver};" & _
           "SourceType=DBF;" & _
           "SourceDB=\\SrvProd\basetest;" & _
           "Exclusive=No"
    sql = "INSERT INTO indic(date, affaire, loginc, engv, engd, refv, refd, logcdp)" & vbCrLf & _
            "VALUES({" & format(Date, "mm/dd/yyyy") & "}, """ & affaire & """, """ & loginc & """, " & engv & ", " & engd & ", " & refv & ", " & refd & ", """ & logcdp & """)"
oconn.Execute (sql)

En espérant que ça aide. ;)

méthode sue j'utise pour accder a lOS via ODDC

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
requete = « select * from malib/monfichier….. »
 
Set feuille = ActiveWorkbook.Worksheets("Lafeuille")
 
IDconnect = "ODBC;DRIVER={Client Access ODBC Driver (32-bit)};ALLOWPROCCALLS=1;PREFETCH=1;LAZYCLOSE=1;TRANSLATE=1;DSP=2;DFT=6;NAM=1;CMT=0;" & _
"PKG=QGPL/DEFAULT(IBM),2,0,1,0,512;LANGUAGEID=ENU;DFTPKGLIB=QGPL;" & _
"DBQ= LIBAS400_1 LIBAS400_2 LIBas400_2   QTEMP;SYSTEM=System_toto;"
 
 
Set ResSQL = feuille.QueryTables.Add(Connection:=IDconnect, Destination:=Range("A1"))
 
    With ResSQL
        .Connection = IDconnect
        .CommandText = requete
        .Refresh BackgroundQuery:=False
 
    End With
 
 Rows("1:1").Select
  Selection.AutoFilter

Une question en sus : comment peut-on remonter a la place des noms des champs , le libellé de ceux-ci?

Citation:

Une question en sus : comment peut-on remonter a la place des noms des champs , le libellé de ceux-ci?

On ne peut pas faire cela depuis l'AS400, mais on peut rapatrier les données depuis l'AS400 sans définition ODBC définie sur le PC. (Datasource)

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
88
89
90
91
Public Sub ReadFileI5Full(ByVal Input_File As String, ByVal Target_worksheet As String, ByVal Target_range As String)
'ReadFileI5Full : get I5 data from Lib.file(member) and insert that in Worksheet at désired range cell
'usage : ReadFileI5Full (File, Worksheet, Range)
' Input_File : can be either Lib.file
'                    or Lib.File(member)
' Target_Worksheet : Must be a valid Worksheet Name : if exists : cleared before fullfillment
'                                              if not exists : will be created
' Target_Range     : Must be a valid cell name : Example "A1"
 
    On Error GoTo ErrorHandler
 
    Dim cn          As New ADODB.Connection
    Dim rs          As New ADODB.Recordset
    Dim sConn       As String
    Dim SqlString   As String
    Dim FileName    As String
    Dim DSN_Name As String
    Dim ws          As String 'Results Storing Worksheet name
    Dim Rg          As String 'results Cells top left
    Dim cellule     As Range
    Dim CompA       As Integer
    Dim idx         As Long
    Dim sheet_found As Boolean
    Dim ActShName   As String
 
 
 
 
 
    sConn = "provider=IBMDA400;Data source=xxx.xxx.xxx.xxx;USER ID=Userid;PASSWORD=Password"
    FileName = Trim(Input_File)
    ws = Trim(Target_worksheet)
    Rg = Trim(Target_range)
 
    'check target Worsksheet exists and if not build
    sheet_found = False
    For idx = 1 To Sheets.Count
        If Sheets(idx).Name = ws Then
            Application.DisplayAlerts = False
            Sheets(idx).Cells.Clear
            Application.DisplayAlerts = True
            sheet_found = True
            Exit For
        End If
    Next idx
    'Build Ws
    If Not sheet_found Then
        ActShName = ActiveSheet.Name
        Sheets.Add
        ActiveSheet.Name = ws
        Sheets(ActShName).Activate
    End If
 
    'Open Connection
    cn.ConnectionString = sConn
    cn.Open
    SqlString = "SELECT * FROM " & FileName & ""
 
    'open record Set
    rs.Open SqlString, cn
 
 
 
    'Paste Fields names in line 1
    Set cellule = Worksheets(ws).Range(Rg)
    For CompA = 0 To rs.Fields.Count - 1
        cellule.Offset(0, CompA).Value = rs.Fields(CompA).Name
    Next CompA
    'Paste results line above names
    Worksheets(ws).Range(Rg).Offset(1, 0).CopyFromRecordset rs
 
    rs.Close
    cn.Close
    Set cn = Nothing
    Set rs = Nothing
 
    Exit Sub
ErrorHandler:
    ' clean up
    If Not cn Is Nothing Then
        If cn.State = adstateopen Then cn.Close
    End If
    Set cn = Nothing
    If Not rs Is Nothing Then
        If rs.State = adstateopen Then rs.Close
    End If
    If Err <> 0 Then
      MsgBox Err.Source & "-->" & Err.Description, , "Error"
    End If
 
End Sub

09/12/2010, 13h26
jfontaine

Bonjour

Question bete mais a tout hazard le poste qui pose probleme a t'il bien un ODBC qui se connecte lors du test de connexion.
Son nom est il bien orthographié "FICHIER_ARTICLES"
09/12/2010, 13h33
Godzestla

Salut Jfontaine,

bien vu. le problème doit presque ceratinement se situer là.

mais avec ma technique d'extraction de données, pas besoin de définition ODBC, juste le driver AS400 ODBC de base installé, une definition de la machine à contacter, et that's all folks.