Categoría : Otros
Autor : Edwin Palma
Título : Transferencia de Archivos del AS400 a Hoja Excel

Descripción del truco:
Permite accesar Cualquier archivo del AS400 y colocarlo en hoja excel. esta información puede ser utilizada luego para generar reportes, tablas dinamicas o cualquier utilidad que uds. desen darles. en mi caso particular genero un archivo resumen en el as400 y esta informacion es actualizada en excel para generar unas tablas dinamicas que se utilizan para toma de decisiones. Recuerden que excel tiene la limitante de 65000 registros.

Nota: Hay que adicionar en Herremientas-referencia del editor de Visual Basic Microsoft Activex Data Objects 2.0 Library "msado20.tlb" para que este codigo pueda funcionar

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 


                        

Ver código fuente
Fecha 01-06-2005

Tienes algún truco que quieras compartir con todos los profesionales de Recursos iSeries AS400?. Envianoslo y si resulta seleccionado te enviaremos un vale de Amazon por valor de 50$

Comentarios de usuarios