日常工作，经常会有遇到一些重复性的从AS400下载数据到本地，或者从本地上传数据到AS400并且颇为繁琐，这里给大家提供一些核心简单代码供大家参考：
环境搭建：1.需要电脑有ODBC连接AS400的驱动，一般电脑安装AS400会同步安装这个驱动，如果没有可以去IBM官网查找
2. Excel 保存为启用宏的模式
ALT+F11 进入开发者模式：
A-》以下三段for AS400 Connection:
'通用变量
Global Const strConnAS400 = "Driver={Client Access ODBC Driver (32-bit)};System=Sever Name"
Set AS400Conn = New ADODB.Connection
AS400Conn.Open strConnAS400, "User Name", "Password"
B-》执行AS400 sql:
AS400Conn.Execute ("Delete from libname.File Name ")
C-》 执行AS400 语句
Call AS400RunCommand("User", "pwd", "Command“）
Public Function AS400RunCommand(ByVal strUserName As String, _
ByVal strPassword As String, _
ByVal strCmd As String) As Boolean
' set up error handling
On Error GoTo ErrorHandler
' set the initial state of the function
AS400RunCommand = False
Dim AS400Conn As New ADODB.Connection
Dim AS400Pgm As New ADODB.Command
' open a connection to the AS400
AS400Conn.Open strConnAS400, "User Name", "Password"
Set AS400Pgm.ActiveConnection = AS400Conn
' create the command text
AS400Pgm.CommandText = "CALL QSYS.QCMDEXC('" & strCmd & "', " & _
Format(Len(strCmd), "0000000000") & ".00000)"
' execute the command
AS400Pgm.Execute
' set the final state of the function
AS400RunCommand = True
ExitHere:
Exit Function
ErrorHandler:
MsgBox "Error:" & Err.Number & vbNewLine & _
"Description:" & Err.Description & vbNewLine & _
"From:" & Err.Source, vbExclamation, _
"AS400RunCommand Failed"
Resume ExitHere
End Function
D-> 从AS400导入数据到本地：
Set aS400Rs = CreateObject("ADODB.Recordset")
sSQL = "SELECT * FROM Library.File name" '
aS400Rs.Open sSQL, AS400Conn, 0, 1, 1
row = 2
If Not aS400Rs.EOF Then
Do While Not aS400Rs.EOF
If IsNull(aS400Rs(0)) Then '文件的第一个变量
' xxx
Else
'xxx
End If
aS400Rs.MoveNext
row = row + 1
Loop
^^^^^^^^^^^^^^^^
注意事项：末尾记得断开连接或者关闭EXCEL,因为会在AS400端挂起一个作业比较吃资源 。欢迎大家探讨
