Excel VBA to Access VBA

[ptw78]

I have the below code running in excel vba. What I want to do is run this into a access table. I'm not to familiar w/access vba. Basically how this is setup now is my excel sheet has it's required header rows already put in and then I run this macro to get data from Extra Mainframe to put in the selected rows/cols. Other than knowing I'll need to change Dim ws As Worksheet & Set ws = ActiveWorkbook.Sheets("Sheet1") I'm not sure what all I need to change to get it to run in an Access table. Anyone able to help. Thanks

Sub queues()
    Application.ScreenUpdating = False
    Dim Sessions, System As Object, Sess0 As Object
    Set System = CreateObject("EXTRA.System")
    Set Sessions = System.Sessions
    Set Sess0 = System.ActiveSession
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Sheets("Sheet1")

    done = Sess0.Screen.GetString(24, 2, 3)
    queue = Sess0.Screen.GetString(2, 10, 11)

    If done <> "END" And queue <> "F0009 / 11" Then
    
        x = 1
        r = 1    
            Do
            
                Sess0.Screen.MoveTo 6, 67
                Sess0.Screen.SendKeys ("f000")
                Sess0.Screen.SendKeys (x)
                Sess0.Screen.MoveTo 7, 67
                Sess0.Screen.SendKeys ("001")
                Sess0.Screen.SendKeys ("<enter>")
                Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
                
              

                    
                       Do
                    
                        r = r + 1
                            
                            
                           acct_num = Sess0.Screen.GetString(3, 19, 10)
                           ws.Cells(r, 1) = acct_num
                           
                           hold_date = Sess0.Screen.GetString(21, 26, 8)
                           ws.Cells(r, 2) = hold_date
                           
                           hold_reason = Sess0.Screen.GetString(21, 44, 1)
                           ws.Cells(r, 3) = hold_reason
                           

                           
                           done2 = Sess0.Screen.GetString(24, 2, 3)
                           
                           Sess0.Screen.SendKeys ("<pf8>")
                           Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
                           
                    
                        Loop Until done2 = "END"
        
            Sess0.Screen.SendKeys ("<pf3>")
            Sess0.Screen.WaitHostQuiet (g_HostSettleTime)
            
            x = x + 1


        Loop Until x = 9
        
    End If

End Sub

 

[SkipVought]

Use ADODB Data Objects. Set a reference in Tools > References for Microsoft ActiveX Data Objects Library, latest version.

Check

http://www.carlprothman.net/Default.aspx?tabid=81

for your connect string.

Here is an example for a Select query. Modify as needed.

Function OperCOMP_Date(sTRAV As String, sOPER As String, sPST_LPST As String, sLast_This As String)
'SkipVought
'--------------------------------------------------
    Dim sConn As String, sSQL As String, sServer As String
    Dim rst As ADODB.Recordset, cnn As ADODB.Connection
    Dim sPath As String, sDB As String
    
    sPath = "\\dfwsrv222\public\Work"
    
    sDB = "DueThisWeek"
    
    cnn.Open "Driver={Microsoft Access Driver (*.mdb)};" & _
               "Dbq=" & sPath & "\" & sDB & ".mdb;"
           
    Set rst = New ADODB.Recordset
    
    sSQL = sSQL & "SELECT"
    sSQL = sSQL & "  TRAVELER, OPER, " & sPST_LPST
    sSQL = sSQL & vbCrLf
    Select Case UCase(sLast_This)
        Case "LAST"
            sSQL = sSQL & "FROM tblLast_Week"
        Case "THIS"
            sSQL = sSQL & "FROM FPRPTSAR_MC_BUILD_SCHEDULE_FP"
    End Select
    sSQL = sSQL & vbCrLf
    sSQL = sSQL & "Where TRAVELER='" & sTRAV & "'"
    sSQL = sSQL & "  AND OPER>'" & sOPER & "'"
        
    Debug.Print sSQL
        
    rst.Open sSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText
                          
    On Error Resume Next
                          
    rst.MoveFirst

    If Err.Number = 0 Then
        If Not rst.EOF Then
            OperCOMP_Date = rst(2)
        Else
        'TRAV complete - use TRAV PCT
        
        End If
    Else
    'no OPEN TRAV
        OperCOMP_Date = DateSerial(1900, 1, 0)
    End If
    
    rst.Close
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
End Function

I'd look at this statement

    rst.Open sSQL, cnn, adOpenStatic, adLockReadOnly, adCmdText

and choose a DYNAMIC open parameter and NOT read only. Also opent you TABLE, not just CmdText (SQL)

You Add a row, assign the values to each column and the UPDATE to the rst (recordset)

Check the microsoft site for HELP on the ADODB objects, specifically the Recordset object.

Post back with your questions.



Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ptw78]

Forgot to mention this is on excel 2000 and will be on access 2000. Thanks for your example. I'll have to really take a look at it. Not sure I quite understand it right now.