Automatically transfer from AS400 to Excel

[garyconnor]

I have a file on the AS400 that I would like to automatically download into my open workbook. Can this be done via a VBA macro? I have client access (v5.5) and Excel 2000 running on an XP client.

I can use the tool bar, but this is too time consuming, I would like to be able to hand this workbook out and allow the users to run the macro themselves, thus removing me from the cirlce.

Can anyone help me please?

Many thanks, in advance.
Gary Connor

 

[Mercury2]

Hi Gary,
Have you tried using the Client Access plug in that allows you to export a file directly into an excel spreadsheet?

 

[garyconnor]

Thank You, but Yes I have tried this but I want to automate it wiith some VBA code, eliminating the need to remember where the file transfer definitions reside.

 

[arrow483]

Here's a sample VB Macro you can install in your Excel sheet under the "Open" event. Modify UserId, password, IP address, library, file name, and SQL statement as needed.

********************************************************

Private Sub Workbook_Open()
Dim Con As New ADODB.Connection
Dim Cmd As New ADODB.Command
Dim Rs As ADODB.Recordset

Con.Open "provider=IBMDA400;data source=192.168.999.999; USER ID=myuserid; PASSWORD=mypassword;"

Set Cmd.ActiveConnection = Con
Cmd.CommandText = "SELECT * FROM mylib.myfile"

Dim rowCount As Integer
Dim colCount As Integer
Dim text As String
Dim Number As Long
Dim val As Variant

Set Rs = Nothing
Set Rs = Cmd.Execute()
Worksheets("sheet1").Activate
Range("A1").Activate
Selection.CurrentRegion.Select
Selection.ClearContents
Range("A1").Select
rowCount = 1

For colCount = 0 To Rs.Fields.Count - 1
Worksheets("Sheet1").Cells(rowCount, colCount + 1).Value = Rs.Fields(colCount).Name
Next colCount

While Not Rs.EOF
rowCount = rowCount + 1
For colCount = 0 To Rs.Fields.Count - 1

If Rs.Fields(colCount).ActualSize = -1 Then
text = ""
Else
val = Rs.Fields(colCount).Value
If VarType(val) = vbNull Then
text = ""
Else
text = val
End If
End If

Worksheets("Sheet1").Cells(rowCount, colCount + 1).Value = text

Next colCount
Rs.MoveNext
Wend

Set Rs = Nothing
Con.Close
End Sub