Código de AS/400 - Leer Informacion de As400 con Macro Excel

sin imagen de perfil
Val: 21
Ha mantenido su posición en AS/400 (en relación al último mes)
Gráfica de AS/400

Leer Informacion de As400 con Macro Excelgráfica de visualizaciones


AS/400

Publicado el 22 de Septiembre del 2016 por Hugo Arturo
4.707 visualizaciones desde el 22 de Septiembre del 2016
para las interfases entre as400 y excel habia que usar transfers, hice macro de excel se concecta a as400 y extrae la informacion

1.0

Actualizado el 9 de Diciembre del 2016 (Publicado el 22 de Septiembre del 2016)gráfica de visualizaciones de la versión: 1.0
4.708 visualizaciones desde el 22 de Septiembre del 2016
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

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
Option Explicit
 
Global As400_Con           As Object
Global As400_Path          As String
 
Global sSQL                As String
Global aS400Rs             As Object
 
Public Function AbreBaseAs400() As Boolean
       On Error GoTo Error_AbreBaseAs400
 
   AbreBaseAs400 = False
 
   As400_Path = "DSN=(nombre de la odbc de as400);uid=XXXXX;pwd=XXXXX;"
   Set As400_Con = CreateObject("ADODB.Connection")
 
   As400_Con.ConnectionString = As400_Path
   As400_Con.Open
 
   AbreBaseAs400 = True
 
   Exit Function
 
Error_AbreBaseAs400:
 
   MsgBox "Error al abrir la Base de Datos As400 " & Err.Number & " " & Err.Description
 
End Function
 
Public Function CierraBaseAs400()
       On Error GoTo Error_CierraBaseAs400
 
   As400_Con.Close
 
Error_CierraBaseAs400:
 
End Function
 
Public Function LeeAs400()
 
   If AbreBaseAs400 Then
 
      Set aS400Rs = CreateObject("ADODB.Recordset")
      sSQL = "SELECT * FROM xxxx.yyyyy"  '

      aS400Rs.Open sSQL, As400_Con, 0, 1, 1
 
      If Not aS400Rs.EOF Then
         Do While Not aS400Rs.EOF
            If IsNull(aS400Rs(0)) Then
'             si los campos son nulos
 
            Else
'              ver la info de cada campo

            End If
           aS400Rs.movenext
         Loop
      Else
         MsgBox "No hay informacion de la consulta "
         aS400Rs.Close
         Set aS400Rs = Nothing
      End If
   End If
 
   Exit Function
 
End Function



Comentarios sobre la versión: 1.0 (0)


No hay comentarios
 

Comentar la versión: 1.0

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios
Es necesario revisar y aceptar las políticas de privacidad

http://lwp-l.com/s3681