Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

How to change a Fixed login to a prompt login

0

Since MS changed the way excel 2013 (and beyond) interacts with an AS400 system IBMs traditional Iseries data transfer addin no longer functions as it did.  I was provided by the wonderful internet this macro to access the same process into excel but due to auditing requirements I need it to  actually prompt for a User name and Password and not use the default hard coded login info in the Macro.

Section to change is the Private Sub InitSQLConnectionDBS

Can anyone out there in the Excel Multiverse help?

Public cnnSQL As New ADODB.Connection
Public iRs1 As Recordset
Public iRs2 As New ADODB.Recordset
Public iRs3 As New ADODB.Recordset
Public iCmd As New ADODB.Command
'AS400 Host Names
Global Const gAS400 = "10.1.7.12"
Global gCommTable(100) As String
_____________________________________________
Private Sub InitSQLConnectionDBS()
    Dim strSource As String
    On Error GoTo cnnErr
    strSource = gAS400
    cnnSQL.Provider = "IBMDA400"
    ' Set USER and PASSWORD next line
    cnnSQL.Open "Data Source = " & strSource, "BIZNEZZ", "amgis11"
    Exit Sub
cnnErr:
    Debug.Print Err.Number & " : " & Err.Description
End Sub
______________________________
Public Function getASWShipment()
'This function retrieves the customers name from ASW and displays it on the worksheet.
'STEP 0. Bypass all errors
    On Error Resume Next
'STEP 1. Define Privates
    Dim strSQL As String
    Dim iCol As Long, iRow As Long, iColOutput As Long
    Dim iCus As String, iFrom As String, iTo As String
    Dim i As Long, j As Long
    Dim inProposal As String
    Dim Count As Integer
    Worksheets("CreditLimitProposal").Range("A7:Z10000").EntireRow.Delete
    inProposal = Worksheets("CreditLimitProposal").Cells(3, 2).Value
'STEP 2. Establish connection to AS400
    Set cnnSQL = Nothing
    InitSQLConnectionDBS
'STEP 3. Get Data
    strSQL = "SELECT CIZ1STAT, CIZ1PPNO,CLZ1TYPE, CIZ1EXRF, CIZ1DENO, NANAME, CIZ1SAAC, CIZ1AVB, CIZ1MULT, CIZ1NPLP, CIZ1CACL, CIZ1CPRO, CIZ1CLMT, CIZ1PPRO, CIZ1PLMT, CIZ1APPR, CIZ1RPRO, CIZ1RLMT, CIZ1RAPR FROM SI2560AFSC.Z1OLP1, SI2560AFSC.Z1OCTLLR, SI2560AFSC.SRONAM WHERE CIZ1PPNO=CLZ1PPNO AND CIZ1DENO = NANUM AND CIZ1PPNO=" & Trim(inProposal)
    'MsgBox strSQL
    iRs2.Open strSQL, cnnSQL, adOpenStatic, adLockOptimistic, adCmdText
    i = 6
    ' Show column headers
    For j = 1 To iRs2.Fields.Count
        'Worksheets("CreditLimitProposal").Cells(i, j).Value = iRs2.Fields(j - 1).Name
    Next
    iRs2.MoveFirst
    Do While Not iRs2.EOF
    If Err = 0 Then
    i = i + 1
    ' Show data
    For j = 1 To iRs2.Fields.Count
        Worksheets("CreditLimitProposal").Cells(i, j).Value = iRs2.Fields(j - 1)
    Next
    End If
    iRs2.MoveNext
    Loop
    iRs2.Close
    Set cnnSQL = Nothing
'STEP 99. Housekeeping
exitsub:
    iRs2.Close
    Set cnnSQL = Nothing
End Function
 

Attached the Macro in a DOC file

Answer
Discuss

Answers

0

An easy fix is to use two user inputs like this:

username = InputBox("Type the username:")
userpass = InputBox("Type password:")

Put this under where it says:  ' Set USER and PASSWORD next line

Then replace BIZNEZZ and amgis11 with username and userpass

Discuss


Answer the Question

You must create an account to use the forum. Create an Account or Login