changing code to get data from a yes/no field instead of form & SendMessage help

**topher23** · Apr 21 '10, 10:25 PM

Give this a try:

Code:

    'My new Code to fix
    strSQL = "Select [tblCE_AddTemp].[Agent_ID] " & _
    "From [tblCE_AddTemp] " & _
    "Where (([tblCE_AddTemp.LeaveBlank] = 0 And [tblCE_AddTemp.Missed] = 0))"
  
     Set db = CurrentDb()
     Set rs = db.OpenRecordset(strSQL)
  
    Text2Clipboard (rs!Agent_ID)
  
    'Finds Agent_ID in IEX
    SendKeys ("%{TAB 1}"), True
    SendKeys ("+{F4 1}"), True
    SendKeys ("%{N 1}"), True
    SendKeys ("{UP 3}"), True
    SendKeys ("{TAB 1}"), True
    SendKeys ("+{END 1}"), True
    SendKeys ("^{V 1}"), True
    SendKeys ("{ENTER 1}"), True
    SendKeys ("{TAB 6}"), True
    SendKeys ("{ENTER 1}"), True

The only change is that DoCmd.RunComman d acCmdCopy is being replaced by the Text2Clipboard function. The acCmdCopy command copies from the current form field that you are on, so that won't work where you've got the data you need in a recordset. Instead, use that function to push the text in the record to the clipboard.

That ought to work. If it doesn't, let us know.

**topher23** · Apr 21 '10, 10:33 PM

I just caught the part about doing this with multiple Agent ID's. I'd have to propose doing a loop around the whole section doing the sendkeys stuff and all of the processing that goes with that, sort of like the following:

Code:

    'My new Code to fix
    strSQL = "Select [tblCE_AddTemp].[Agent_ID] " & _
    "From [tblCE_AddTemp] " & _
    "Where (([tblCE_AddTemp.LeaveBlank] = 0 And [tblCE_AddTemp.Missed] = 0))"
  
     Set db = CurrentDb()
     Set rs = db.OpenRecordset(strSQL)
      
    If Not rs.RecordCount = 0 Then
        Do Until rs.EOF
  
         Text2Clipboard (rs!Agent_ID)
         
         
         'All the rest of the subroutine body
         
         
         rs.MoveNext
        Loop
    End If
 End Sub

**JMANTN** · Apr 21 '10, 10:34 PM

I was so close yet so far away! Thank You! I've been working on this for 5 hours today!

It seems like I will need to find a way to loop through each record in the table that hasn't been marked as missed or leaveblank as this processes only one agent but at least that's working :)

Also it's not copying the exception however I suspect that's on my end as well. Thanks so much. I'm going to try and fix the exception portion first then attempt the loop (think that's what I'd use for this situation) with each agent.

Thanks Topher just seen your update and that should be enough to get me going. I do enjoy trying to figure this out but when I've put in more than 3 hours on something is when I do a call for help as it's almost always something I'm overlooking or just not experienced enough to catch.

**topher23** · Apr 21 '10, 10:47 PM

As a bit of an aside, I have a similar setup where I work, where we originally used a lot of SendKeys to push data from our local database to the corporate SCM database. As you may know, SendKeys can be very finicky in this type of situation.

In order to stabilize the process, I created a form with an Internet Explorer ActiveX browser control on it, used the browser control to navigate to the page I needed, then accessed the actual web form controls through the browser, allowing me to set them directly. like so:

Code:

        'log in to SCM with the password "H8ER"
        Me.ieBrowser.Document.login.pwd.Value = "H8ER"
        'the control is called ieBrowser, Document references the active HTML page,
        'the frame on the page is called login and the field is pwd.

This ended up being so much better than tabbing across a page and throwing out text, hoping it went into the right place.

**JMANTN** · Apr 22 '10, 02:12 AM

Topher, Thanks I will give that a try once I have a working process with this. Out of curiosity have you ever tried SendMessage versus the method you described? As once I get this working with my db I'm definitely changing it and updating it.

I haven't stopped working on this since this morning but taking a break from it tonight. I've updated some of the code so I'll post below.

Code:

Private Sub cmdEnterTRNG_Click()
   Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim intStartMinute As Integer
    Dim intLength As Integer
    Dim intLunchLength As Integer
    Dim intException As Integer
    Dim intError As Integer
    Dim strCopy As String
    Dim strWholeSchedule As String
    Dim blManual As Boolean
    
    'Me.txtCopy = Null
    
    'Grabs Agent_ID
    'Me.ACDID.SetFocus
     strSQL = "Select [tblCE_AddTemp].[Agent_ID] " & _
     "From [tblCE_AddTemp] " & _
     "Where (([tblCE_AddTemp.LeaveBlank] = 0 And [tblCE_AddTemp.Missed] = 0))"

      Set db = CurrentDb()
      Set rs = db.OpenRecordset(strSQL)

     Text2Clipboard (rs!Agent_ID)

     'Finds Agent_ID in IEX
     SendKeys ("%{TAB 1}"), True
     SendKeys ("+{F4 1}"), True
     SendKeys ("%{N 1}"), True
     SendKeys ("{UP 3}"), True
     SendKeys ("{TAB 1}"), True
     SendKeys ("+{END 1}"), True
     SendKeys ("^{V 1}"), True
     SendKeys ("{ENTER 1}"), True
     SendKeys ("{TAB 6}"), True
     SendKeys ("{ENTER 1}"), True
    
    'Copies schedule from IEX
    SendKeys ("%{E 1}"), True
    SendKeys ("{DOWN 5}"), True
    SendKeys ("{ENTER 1}"), True
    
    'Returns to Access
    SendKeys ("%{TAB 1}"), True
    
    strWholeSchedule = Clipboard2Text()
    
    rs.Close: db.Close
    Set rs = Nothing: Set db = Nothing
    
    
    
    
    'Finds exception to key in IEX
   Set db = CurrentDb
   Set rs = CurrentDb.OpenRecordset(strSQL)
   If Not (rs.BOF And rs.EOF) Then
   'If rs.RecordCount = 0 Then
        intException = Val(cboTTVTRNG.Value)
   Else
        strError = "Exception not in avialble list"
        MsgBox "Please Manualy Key This. (" & strError & ")"
        rs.Close: db.Close
        Set rs = Nothing: Set db = Nothing
        Sleep (1)
        Exit Sub
   End If
    
    rs.Close: db.Close
    Set rs = Nothing: Set db = Nothing
    
    
    
    
    'Creates the exception to be pasted into IEX
    intStartMinute = DateDiff("n", #12:00:00 AM#, Me.txtTTVTRNGStart)
    intLength = DateDiff("n", Me.txtTTVTRNGStart, Me.txtTTVTRNGEnd)
    strCopy = intStartMinute & "|" & intLength & "|" & intException
    
    'Verifies if the new exception will fit in the current schedule
    varschedule = Split(strWholeSchedule, "|")
       
    x = Null
    x = Split(FindLunch(strWholeSchedule), ",")
    intLunchLength = Val(x(2))
    y = Null
    y = Split(strWholeSchedule, "|")
    
    'Can't remember what this one does
    If y(1) = 0 Then
        blManual = True
        strError = "ERROR 2"
    End If
    
    'Checks to make sure there is a lunch in the schedule
    'Braced Out for testing 11/11/2008
'    If x(0) = 0 And x(1) = 0 And x(2) = 0 Then
'       blManual = True
'       intError = 3
'   End If
    
'    If blManual = True Then
'       MsgBox "Please Manualy Key This. e(" & intError & ")"
'       Sleep (1)
'       ToggleNumLock (True)
'       Sleep (1)
'       Exit Sub
'   End If
    
    If intLength = varschedule(1) And varschedule(1) >= 480 Then
        Debug.Print
        'Builds exception before lunch
        strCopy = Val(varschedule(0)) & "|" & Val(varschedule(1)) & "|" & intException & "," & Val(varschedule(0)) & "," & Val(x(1)) - Val(varschedule(0)) & ","
        'Builds Lunch
        strCopy = strCopy & Val(x(0)) & "," & Val(x(1)) & "," & Val(x(2)) & ","
        'Builds exception after lunch
        strCopy = strCopy & intException & "," & Val(x(1)) + Val(x(2)) & "," & _
                    (Val(varschedule(1)) - Val(x(2))) - (Val(x(1)) - Val(varschedule(0)))
        'Tacks on the junk at the end of the schedule
        strCopy = strCopy & "|-1|0"
        
        Me.txtTTVTRNGStart = DateAdd("n", Val(varschedule(0)), #12:00:00 AM#)
        Me.txtTTVTRNGEnd = DateAdd("n", Val(varschedule(1)), Me.txtTTVTRNGStart)
        Me.txtTRNGDuration = DateDiff("n", Me.txtTTVTRNGStart, Me.txtTTVTRNGEnd)
    Else
        blManual = False
        If intStartMinute < Val(varschedule(0)) Or _
           intStartMinute + intLength > Val(varschedule(0)) + Val(varschedule(1)) Then
            blManual = True
            strError = "OUTSIDE SHIFT"
        End If
        
'        If Val(varschedule(1)) > 600 + intLunchLength And intStartMinute + intLength > Val(varschedule(0)) + intLunchLength + 480 Then
'            blManual = True
'            strError = "SHIFT GREATER THAN 10HOURS"
'        End If
        
'        If Val(varschedule(1)) < 480 Then
'            blManual = True
'            strError = "SHIFT LESS THAN 8 HOURS"
'        End If
        
        If blManual = True Then
            MsgBox "Please Manualy Key This. (" & strError & ")"
            'Call Sleep(1)
            Exit Sub
        End If
    End If
    
    'Checks to see if there is any overlaps - This part doesn't work completely yet
    'Call DisectSchedule(strWholeSchedule)
    
    
    'Collects the exception to paste into IEX
    Call ClearClipboard
    Text2Clipboard (strCopy)
    
    'Goes back to IEX and pastes info
    SendKeys ("%{TAB 1}"), True
    SendKeys ("%{E 1}"), True
    SendKeys ("{DOWN 3}"), True
    SendKeys ("{ENTER 1}"), True
    
    '-----------------------
    'Sleep (5)
    'SendKeys ("%{E 1}"), True
    'SendKeys ("{DOWN}"), True
    'SendKeys ("{ENTER 1}"), True
    'Sleep (3)
    'SendKeys ("%{E 1}"), True
    'SendKeys ("{DOWN 3}"), True
    'SendKeys ("{ENTER 1}"), True
    '-----------------------
    
    'Turns NumLock On
    'ToggleNumLock (True)

    
End Sub

The problem I'm still having (as I haven't attempted to do multiple Agents yet) is to get it to actually paste the code into my other program IEX. Everything looks correct when the code executes and selects the correct agent however no exception is getting pasted. I have a hunch where my problem is (not too far down from top) but have no clue how to go about solving this but then again I've been working on this almost 11 hours.

Code:

'Finds exception to key in IEX
    strSQL = "SELECT tbl_All_Code_Types.Qualifier, tbl_All_Code_Types.Absense_Type " & _
             "FROM tbl_All_Code_Types " & _
             "WHERE (((tbl_All_Code_Types.Absense_Type)=" & Chr(34) & Me.Exception_Code & Chr(34) & "));"
    Set db = CurrentDb
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
    If rs.RecordCount = 1 Then
        intException = Val(rs!qualifier)
    Else
        strError = "Exception not in avialble list"
        MsgBox "Please Manualy Key This. (" & strError & ")"
        rs.Close: db.Close
        Set rs = Nothing: Set db = Nothing

The small section of code above is the original and below is mind. The original code is doing a recordcount which was fine for the old database that processed one exception for one agent at a time however I am unsure how to correctly switch out that code as I'm thinking that's the part keeping the process from working correctly.

Code:

'Finds exception to key in IEX
   Set db = CurrentDb
   Set rs = CurrentDb.OpenRecordset(strSQL) 'Prob needs to be '
'changed/removed

   If Not (rs.BOF And rs.EOF) Then 
   'If rs.RecordCount = 0 Then  'I just tried switching out the Record Count
        intException = Val(cboTTVTRNG.Value)
   Else
        strError = "Exception not in avialble list"
        MsgBox "Please Manualy Key This. (" & strError & ")"
        rs.Close: db.Close
        Set rs = Nothing: Set db = Nothing
        Sleep (1)
        Exit Sub
   End If
    
    rs.Close: db.Close
    Set rs = Nothing: Set db = Nothing

**JMANTN** · Apr 27 '10, 10:00 PM

Originally posted by topher23

I just caught the part about doing this with multiple Agent ID's. I'd have to propose doing a loop around the whole section doing the sendkeys stuff and all of the processing that goes with that, sort of like the following:

Code:

    'My new Code to fix
    strSQL = "Select [tblCE_AddTemp].[Agent_ID] " & _
    "From [tblCE_AddTemp] " & _
    "Where (([tblCE_AddTemp.LeaveBlank] = 0 And [tblCE_AddTemp.Missed] = 0))"
  
     Set db = CurrentDb()
     Set rs = db.OpenRecordset(strSQL)
      
    If Not rs.RecordCount = 0 Then
        Do Until rs.EOF
  
         Text2Clipboard (rs!Agent_ID)
         
         
         'All the rest of the subroutine body
         
         
         rs.MoveNext
        Loop
    End If
 End Sub

I have finally figured this out and my issue was that the exception selected on the form wasn't being picked up by vba correctly due to the table layout so I created a hidden text field on the form with a dlookup referencing which exception was selected and have it reflect the TTV code and that fixed everything.

Topher: your assistance with the looping through each record saved me a ton of time however it was getting hung up after the first agent and I eventually figured out I needed an additional

Code:

SendKeys ("%{TAB 1}"), True

prior to the rs.MoveNext at the end to have it switch back to Access. Pretty simple once you step back from it but it took me forever to realize that.
Alas it was a learning experience for sure!

I intend on exploring your suggestion on integrating with internet explorer once I get everything up and running as we could have used this db a long time ago so I need something working asap. Do you have any links or references that you would suggest to point me in the right direction with this? I'm also very curious as the next step of my db is to link up to an outside vendor website that we have to submit data to and I'm having a rough time finding what constants to use and finding the right ID's for the web elements (hope that's worded right). Think I'll start a new thread on that one however as I've been googling for a few days with no dice.

changing code to get data from a yes/no field instead of form & SendMessage help

changing code to get data from a yes/no field instead of form & SendMessage help

Comment

Comment

Comment

Comment

Comment

Comment