We value your feedback.
Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Sub GetInfo() 'These variables are used getting data from AS/400 Dim con As New ADODB.Connection Dim rs As New ADODB.Recordset 'This variable is used for the sql query (to split long lines) Dim sSQL As String 'Begin import from AS/400 con.Open "PROVIDER=IBMDA400;Data Source=XXXXXXXXX;USER ID=" & Sheets("Input").Range("D9") & ";PASSWORD=" & Sheets("Input").Range("D10") & ";" Set rs.ActiveConnection = con 'Loop thru marked cells, create tab, run SQL against AS/400 Dim x As Range For Each x In Sheets("Input").Range("P13:P22") Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets 'if the worksheet name equals the current value of x (the value shown in P13:P22) copy the worksheet and name it the current value of x If ws.Name = x Then ws.Copy Before:=Worksheets(ws.Name) 'renames the worksheet with the value in column B. if a worksheet already exists with that name, add a number to the name so sheet "First One" becomes "First One (1)" On Error Resume Next ActiveSheet.Name = x.Offset(0, -13).Value & " " If Err.Number <> 0 Then Dim miniLoop As Integer miniLoop = 1 Do While Err.Number <> 0 Err.Clear ActiveSheet.Name = x.Offset(0, -13).Value & " (" & miniLoop & ")" miniLoop = miniLoop + 1 Loop Err.Clear End If ' At this point the worksheet has been created and named to match the value on sheet "Input" ' Now the query is run against AS/400 sSQL = "SELECT field1,field2,field3,field4,field5,field6,field7,field8 " & vbCrLf sSQL = sSQL & "FROM Library.Table " & vbCrLf 'The following line is the problem sSQL = sSQL & "WHERE (field1=" & Sheets("Input").Range("Q13") & " AND field2=" & Sheets("Input").Range("R13") & ")" & vbCrLf 'We're good from this point on rs.Open (sSQL) ActiveSheet.Range("P1").Offset(1, 0).CopyFromRecordset rs rs.Close End If Next ws Next x Sheets("Input").Select Range("A1").Select MsgBox "Data has been imported.", vbOKOnly End Sub