Discussion :

[NATOU2]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Godzestla]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[NATOU2]

Merci beaucoup