• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1143
  • Last Modified:

How to multithread a SENDKEYS "{SHIFTDOWN}" call

My Problem. I am working in VB6.

We are seeking to establish a list of Access Databases that make use of data in another key application.
This application will be retired shortly and replaced, hence we need to alter the Access applications to ensure continuity of use.

We can easily find all the linked tables using tableDef from the DAO database properties but need to also find connection strings in the modules that are in use. Therefore to find an Access.Application object we need to use the OpenCurrentDatabase method of the Application object. This works fine.

The problem is, using this method invokes the open event of the database in which some of our application check for the directory they are running from and, if not in the correct location, close down after presenting an message box.  Not a major problem if you can hold the shift key down while the script is running, except it is unrealistic  to stick around for the processing of potentially 3500 Access databases.  

Therefore we would like to open the database holding the shift key down meaning the database will open silently. I have yet to find a successful method of doing this. I have investigated upgrading the application to .NET but this proved to be more work than is realistic.

I found an article about background processes  at http://msdn2.microsoft.com/en-us/library/aa719109.aspx which filled me with hope but cannot seem to adapt it to my situation.

Any help appreciated.
Cheers

Calling Form
=======================================================================
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private WithEvents background As NetFX20Wrapper.BackgroundWorkerWrapper
 
Private Sub background_RunWorkerCompleted(ByVal sender As Variant, ByVal e As NetFX20Wrapper.RunWorkerCompletedEventArgsWrapper)
    If e.Error.Number <> 0 Then
        MsgBox "Error in background process: " & e.Error.Description
    Else
        If e.Cancelled Then
            MsgBox "Background process cancelled."
        Else
            MsgBox "Completed processing of: " & e.GetResult
        End If
    End If
End Sub
 
Private Sub StartBackGroundNow()
    StartBackGround background, "Test Operation"
End Sub
 
Private Sub StopBackGroundNow()
    background.CancelAsync
End Sub
 
Private Sub cmdButton_Click(Index As Integer)
 
    
      StartBackGroundNow
    
      Screen.MousePointer = vbHourglass
      For Each lvLI In lvFoundFiles.ListItems
        If lvLI.Checked = True Then
          If lvLI.ListSubItems(2) = "." Then
            lvLI.ListSubItems(2) = 0
          End If
          If AnalyseTables(lvLI.ListSubItems(1), lvLI.Text, lvLI.ListSubItems(2), sbarStatus) = True Then
            lvLI.Checked = False
            DoEvents
          End If
        End If
      Next
      
      
      Screen.MousePointer = vbDefault
      sbarStatus.Panels(1).Text = "Finished"
      
      Screen.MousePointer = vbHourglass
      StopBackGroundNow
      Sleep 5010
      Screen.MousePointer = vbDefault
          
      unload.me 
  End Select
End Sub
 
==============================================================================================================
 
 
Public Function AnalyseModules(strMDB As String, strMDBPath As String, SearchString As String, ModuleList As String) As Boolean
' --------------------------------------------------------------------------------------------------------------------------------------
' Purpose   :
'
'       This function checks each code module in an access database for the occurance of a particular string.
'       If the string is found the module name is added to as list of modules and returned to the calling function.
'
' Arguments :
'
'    Passed to:
'       strMDB        - the file name of the database being analysed.
'       strMDBPath    - the path to the database being analysed.
'
'    Passed from:
'       ModulesContainingSearchString   - List of modules which contained the search string.
'
' Returns   : Boolean - indicates if database was able to be analysed
' Comments  :
' History   : GP - Created Function 23/1/2008
' --------------------------------------------------------------------------------------------------------------------------------------
 
    On Error GoTo Err_AnalyseModules
    
    Dim background As NetFX20Wrapper.BackgroundWorkerWrapper
 
    AnalyseModules = False
 
    Dim App As Access.Application                                 'Gets an application object so modules may be accessed
    Dim dbModules As Modules
    Dim dbModule As Module
        
    Dim StartLine As Long                                         'Used in Module.Find method - Start line for search
    Dim StartCol As Long                                          'Used in Module.Find method - Start column for search
    Dim EndLine As Long                                           'Used in Module.Find method - End line of search (after match found)
    Dim EndCol As Long                                            'Used in Module.Find method - End column of search (after match found)
    Dim x As Long
    
    Set App = New Access.Application
   
    App.OpenCurrentDatabase strMDBPath & strMDB, False
 
    Set dbModules = App.Modules
    
    For x = 0 To dbModules.Count - 1
        Set dbModule = dbModules(x)
        StartLine = 0
        StartCol = 0
        EndLine = 0
        EndCol = 0
        
        If dbModule.Find(SearchString, StartLine, StartCol, EndLine, EndCol, False, True) Then
            If ModuleList = "" Then
                ModuleList = dbModule.Name
            Else
                ModuleList = ModuleList & ", " & dbModule.Name
            End If
            Debug.Print ModuleList
        End If
    Next
    
    AnalyseModules = True
    App.CloseCurrentDatabase
Exit_Function:
        
    Exit Function
Err_AnalyseModules:
    'Some databases will not be able to be analysed because they need to run in a specific location.
    'When this error occurs we will continue processing and report the database was not checked for connection strings
    
    Resume Exit_Function
End Function
 
==========================================================================================================================
Module1
 
 
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Private m_background As NetFX20Wrapper.BackgroundWorkerWrapper
 
Public Sub StartBackGround(background As NetFX20Wrapper.BackgroundWorkerWrapper, argument As Variant)
    Set m_background = background
    m_background.RunWorkerAsync AddressOf BackgroundWork, argument
End Sub
 
Public Sub BackgroundWork(ByRef argument As Variant, ByRef e As NetFX20Wrapper.RunWorkerCompletedEventArgsWrapper)
    On Error GoTo eh
    
    'Err.Raise 1, "", "Something Bad Happened"  ' Force error to test error handling
    
    Dim i As Integer
    For i = 1 To 20
        Sleep 500
        m_background.ReportProgress i * 5
        If m_background.CancellationPending Then
            e.Cancelled = True
            Exit Sub
        End If
    Next
    
    e.SetResult argument
    SendKeys "(SHIFTDOWN}"
    Exit Sub
    
eh:
    e.Error.Number = Err.Number
    e.Error.Description = Err.Description
End Sub

Open in new window

0
Wee_Pecky
Asked:
Wee_Pecky
  • 8
  • 4
  • 2
1 Solution
 
jefftwilleyCommented:
Kind of quiet in here :o)

Have you considered using Workspace to assist you

Dim dbsCurrent As Database, dbsContacts As Database
Set dbsCurrent = CurrentDb
Set dbsContacts = DBEngine.Workspaces(0).OpenDatabase("Contacts.mdb")

Opening a database using this method doesn't actually open the database but creates an object instance of it. Is it your intention to open the VBA code and search the text for any connection strings?

J
0
 
jefftwilleyCommented:
Here's a thread that tells you how to search through the code of a database for a string. May be helpful if you don't already have it.
http://www.experts-exchange.com/Microsoft/Development/MS_Access/Q_20501712.html
J
0
 
Wee_PeckyAuthor Commented:
Thanks but this does not help.

We are not running the code in an access database so Set Db=CurrentDb will not work.
You cannot get a handle to the Module object from DAO, not one that you can expose and search the module code with.

This line in  the searchorreplace function show in the link you provided returns the error "you have performed an illegal operation."

   Set mdl = Modules(ModuleName)

0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
Wee_PeckyAuthor Commented:
How I have solved my own problem...

1. I wrote a dll in VB.NET (obvious when you think about it) and used the multi threading capability to dismiss the start up dialog box presented when the OPENDATABASE method is invoked.

2. I altered my approach so that rather than trying to hold a shift key down and get the db to open I log all database names that do not open. This gives the boffins running the application an opportunity to go back to the failures and manually hold the shift key down while the application runs on just one or two databases.

3. I am continuing to search for a method of sending a SHIFTDOWN and SHIFTUP keypress so we can capture these databases in the one run.

TO THE ADMINISTRATOR - This question is now closed, <humour>can I have 500 points? </humour>
0
 
23637269Commented:
Do a search on VB6 enumeration.
I had a great demo that would start calc. and have buttons clicked etc without user input.

All you would have had to do was probably comment out the msgbox, or even better trap the error number and build your own error trap handler so that the program runs without user interaction.

Thanks
Roger
0
 
Wee_PeckyAuthor Commented:
Thanks Roger,

I actually found your demo. Very Nice!
Unfortunately I need to have a shift key held down during the entire execution of a program start up.
I have compromised. Happy with that. I would prefer not to use SendKeys to dismiss the dialog box (which is not an error) which is presented when the access database starts up in the "wrong" directory. I am reading to find a way to do this, which is think should be easy to find.

Thanks your help.
Wee.
0
 
23637269Commented:
You can simulate the shift key being held down with sendkeys or any number of keys.
You can send them once, or put them in a loop until a situation is met, or put them in a timer or many other combinations.

Thanks
Roger
0
 
23637269Commented:
You can get the ProcessID of the app when it starts and send whatever you want to it with API calls.
Let me know if you are interested.

Thanks
Roger
0
 
Wee_PeckyAuthor Commented:
Hi Roger,

I am interested.

Cheers
Wee
0
 
Wee_PeckyAuthor Commented:
I found this:

[code]
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Integer, _
ByRef lpdwProcessId As IntPtr) As IntPtr

  Public Sub KillProcessByPID(ByVal App As Access.Application)
        ' create the access instance...
        ' let's get it's process!
        Dim processId As IntPtr
        Dim Process As Process = Process.GetProcessById(processId.ToInt32())

        ' we ignore the return value, since we don't care
        ' about the thread id...
        GetWindowThreadProcessId(App.hWndAccessApp, processId)
        Debug.Print("Killing Process id: " & processId.ToString)

        Process.Kill()
End Sub
[/code]

Is this what you were refering to?

I am running two threads. One to run the main app, and one to dismiss the dialog window which presents when the database is "unable to start".
The thread which checks for the dialog window is a "set and forget" process which polls every 1000 ms. Is it possible to pass the App object in a threadsafe manner?

OR

are you suggesting something different?

Cheers & Thanks
0
 
Wee_PeckyAuthor Commented:
Hey Roger,

Don't worry, I found my answer at

http://www.mvps.org/access/api/api0068.htm

Have yet to get it working, but it looks promissing.
Cheers
Wee
0
 
Wee_PeckyAuthor Commented:
How this was resolved...

Thanks to Roger, who pointed me in the right direction, before which I was floundering badly.
The code is as shown below.

Credits:
http://www.mvps.org/access/api/api0068.htm - almost but not quite
http://blogs.msdn.com/robgruen/archive/2004/04/15/114020.aspx - just needed to add the shift key and play a bit.

Cheers

HoldShiftKeyDown.txt
0
 
Wee_PeckyAuthor Commented:
Roger, I found a solution to my prob, thanks to your pointing me in the right direction.
Thanks for your input!
Wee.
0
 
23637269Commented:
Nice piece of work on your part.  Sorry I was down the last few days.  We added on to the office and there were a lot of problems :)

If I can do anything else let me know.

Thanks
Roger
0

Featured Post

Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

  • 8
  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now