Dim nfile As Integer
Dim strConnecion As String

Dim strSql As String
Dim obj As Object
Dim cmObject As Object
Dim GetRS400  As ADODB.Recordset
On Error GoTo Err_Handled
 
 Sheets("Hoja2").Select
  Cells.Select
    Selection.ClearContents
nfile = FreeFile
Close 1

'Hay que crear una Coneccion al AS400 Via ODBC, en este caso se llama "AtencionReclamos"'

strConnecion = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=AtencionReclamos;Initial Catalog=DB2400"
    Set cnAS400 = New ADODB.Connection
    With cnAS400
      .ConnectionString = strConnecion
      .CursorLocation = adUseServer
      .Open
    End With
If cnAS400.State <> 1 Then
       AbrirAS400 = False
       Set cnAS400 = Nothing
       Exit Function
    End If
    AbrirAS400 = True

'La instruccion SQL que permite obtener el archivo del AS400 puede tener parametros, todo depende de la necesidad de cada quien.  En este caso tiene 2 parametros el trimestre y el aņo los cuales se piden en una pantalla adicional' 

WHERE = " WHERE INDTRI=" & "'" & tri & "'" & " AND AŅOAP=" & "'" & anpro & "'"

strcadena = "SELECT * FROM SNSF01" & WHERE
   
   Set cmObject = New ADODB.Command
   cmObject.ActiveConnection = cnAS400
   
   'Ejecuta la instruccion SQL'
   cmObject.CommandText = strcadena
   Set GetRS400 = cmObject.Execute
    
   'Si no es fin de archivo hay informacion' 
     If GetRS400.EOF = False Then
      i=2
      While Not GetRS400.EOF
         'Coloco en la hoja2 a partir de la fila 2 
         la informacion requerida'

         VALOR = "A" & Trim(Str(i))
         Range(VALOR).Value = GetRS400(0)
         VALOR = "B" & Trim(Str(i))
         Range(VALOR).Value = GetRS400(1)
         VALOR = "C" & Trim(Str(i))
         Range(VALOR).Value = GetRS400(2)
         VALOR = "D" & Trim(Str(i))
         Range(VALOR).Value = GetRS400(3)
         VALOR = "E" & Trim(Str(i))
         Range(VALOR).Value = GetRS400(4)
         VALOR = "F" & Trim(Str(i))
        Range(VALOR).Value = GetRS400(5)
        VALOR = "G" & Trim(Str(i))
        GetRS400.MoveNext
         i = i + 1
   Wend
Else
   MsgBox "No existen Registros Para el Trimestre solicitado."
End If

End Sub