connection AS400 depuis Excel Vba

Bonjour à tous,

Je n'arrive pas à me connecter sur l'AS400 depuis Excel, c'est à l'ouverture du chemin de connection que l'erreur se produit (erreur automation),voici mon code :

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
Public Sub connect()
 
Dim datdeb As String, datfin As String, Listagences As String, Listcpte As String, Listcode As String
Dim cnnConn As ADODB.Connection
Dim rstRecordset As ADODB.Recordset
Dim strSql As String
 
' Open the connection.
Set cnnConn = New ADODB.Connection
With cnnConn
    .ConnectionString = _
        "Provider=IBMDA400;Data Source=HEPSTG1;Defaut Collection=ECFH0"
    .Open
End With
 
' Open the recordset.
 
Listagences = Range("H2")
Listcpte = Range("C4")
Listcode = Range("C2")
datdeb = Range("C3")
datfin = Range("H3")
 
Set rstRecordset = New ADODB.Recordset
Set rstRecordset.ActiveConnection = cnnConn
strSql = "SELECT SCQCLS, SCQAGC, SCQDPT, SCQDFA" & _
"FROM SCQPOS" & _
"WHERE SCQSTE In (" & Listcode & ") and SCQAGC In (" & Listagences & ") and SCQSCE=40 and SCQCLS In (" & Listcpte & ") and SCQTYP=1 and SCQPOS=1 and SCQDFA BETWEEN '" & datdeb & "' AND '" & datfin & "'"
 
rstRecordset.Open strSql, cnnConn, adOpenDynamic, adLockReadOnly
 
Application.Range("A500").CopyFromRecordset rstRecordset
 
cnnConn.Close
Set rstRecordset = Nothing
Set cnnConn = Nothing
 
End Sub

Un petit coup de pouce svp. Merci

Bonsoir,

ton système n'est pas adéquat.
Il te faut une connection ODBC, une description Microsoft Query du fichier AS400 à importer (.DQY) et alors tu peux faire comme ceci dans ton code (ps, code non optimisé):

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
 
    Sheets("External").Select
    Cells.Select
    Selection.ClearContents
    Selection.QueryTable.Delete
    Range("A1").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;C:\DATA\Transfert\13-DW\SQL\TRANSFERT__FCOL_.dqy", Destination _
        :=Range("A1"))
        .Name = "TRANSFERT__FCOL_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .Refresh BackgroundQuery:=False
    End With

Merci beaucoup