Solved: Setting VB code to listen on com port for input

Hi,

You just need to open the port, then continually read the contents of the input stream until a pre-defined value (let's say <END>) is received. Once that value is read, then the loop terminates & the input stream is closed.

BFN,

fp.

Adam314

The best/easiest way to read the data will depend on how it is coming in. Possible ways to read data would be:
string = input(number,#1)
input #1, string1,string2,string3,...
line input #1,string1

As fanpages said, continously read, and stop when you get the <END> value.

Sub OpenComPort
continue=true
Open "COM1:9600,n,8,1" For Input As #1
while continue=true
'read data... if it is the <END> value, set continue=false
'otherwise, process it as needed
wend
Close #1
End Sub

saladart

ASKER

Fanpages,

How is that accomplished programatically? I am still not a programming guru and I learn a lot from the information shared on Experts-Exchange...

Can you please provide the additional code to accomplish what you are explaining above?

I can tell you that the communications data block starts with an STX then the data and ends with and ETX command.

Researching further, STX is the ASCII start of transmission character (ASCII Decimal 2) and the ETX is the standard ASCII end of transmission character (ASCII Decimal 3).

Thanks!

Sean

[ fanpages ]

The detection of the end of the input stream need not be determined by the contents of the incoming text, it could also be by a key click (or similar event).

For example:

Dim blnContinue As Boolean

Sub Button_Start_Click()

Open "COM1:9600,n,8,1" For Input As #1

blnContinue = True

While (blnContinue)

DoEvents()

If (blnContinue) Then
' Read data & process as required
End If

Wend

Close #1

End Sub

Sub Button_Stop_Click()

blnContinue = False

End Sub

BFN,

fp.

saladart

ASKER

Adam314 (and FanPages)

The data will be coming in as such:

STX<data string>ETX (this process happens whenever a card is swiped on the card reader that is providing the serial communications to the application.

If I could have it the way I would like it to be, it would be:

If the card is swiped, some process is always listening for the STX - or knows when the card is swiped. The data string is input into the application and then the process starts over again.

HTH,

Sean

[ fanpages ]

Hi Sean,

Not sure if you comment crossed with Adam's, but he has grasped what I was referring to.

I would suspect that the STX & ETX characters are sent around the entire packet of data from the source ('sender') process streaming the data, and opening the COM port and reading data in this manner will probably strip these.

However, if you could wait until you had received a Chr$(2) in the input stream before processing any data, and stop processing when a Chr$(3) was read.

Is the data sent in any pre-defined format from the sender? Does it have fixed-length records, or is it just a stready stream of characters?

In order to read & detect STX & ETX you may need to read individual bytes of data, one at a time; rather than a fixed string length.

BFN,

fp.

[ fanpages ]

Hi again,

OK... if STX is the prefix & ETX is the suffix...

Dim blnContinue As Boolean
Dim strInput As String

Open "COM1:9600,n,8,1" For Input As #1

blnContinue = True

While (blnContinue)

DoEvents()

Input #1, strInput

If Left$(strInput, 1) = Chr$(2) And _
Right$(strInput, 1) = Chr$(3) Then
' Process data [which will be Mid$(strInput, 2, Len(strInput)-2)]
blnContinue = False
End If

Wend

Close #1

BFN,

fp.

saladart

ASKER

The data is in a pre-defined format with fixed length records. I will be receiving the layout tomorrow.

The code needs to know when the STX is sent and when the ETX is sent. Anything after the STX is data that I need to capture and I need to stop capturing the data when the ETX is detected. Hope this makes sense...and I hope this helps you - help me....

Thanks for your assistance!

Sean

saladart

ASKER

Thanks Fanpages,

I have one bug - the line DoEvents() gives me a compile error, specifically a SYNTAX ERROR...

Can you help out with this little issue?

Thanks!

Sean

[ fanpages ]

Hi again,

If it's fixed length, let's say the data content is 100 characters, then add 2 for the STX & ETX, and change my last code posting as follows:

From...
Dim strInput As String

To...
Dim strInput As String * 102 ' 100 + STX + ETX

However, do you just wish to process one set of data then stop reading, or do you wish to continually read data from the port, processing valid records (that start with STX & end with ETX, and are 100 characters in-between)?

I'm going to bed now (00:30am, UK time), but yes, would like to carry on with the discussions tomorrow once you have a better understanding of the data format.

'Night all...

BFN,

fp.

[ fanpages ]

DoEvents() gives you a syntax error? Oh yes, sorry... just DoEvents - no braces on the end!

I'm typing directly into the comment window here online, not using MS-Excel first.

Apologies again...

saladart

ASKER

No prob...

When you start up again - here is something to ponder on...and I will post an add on question for the points...

I would like for the code to be "always waiting" for an STX to come in via com1. What I have to do is parse the "FIXED LENGTH" data string and be able to display it immediately - whether it be in Excel or Access doesn't matter to me.

This is what I am faced with. People swiping their cards. Right after they swipe their card, the information from the card needs to be VERIFIED with the person swiping the card. If the data goes directly into a PRE-FORMATTED worksheet, in the proper fields (which I have been promised to have tomorrow), then I am golden! That is all I will need. The rest of the things that need to be done within Excel (or Access), I can take care of. I just need the means for getting the data from the card that is swiped in the card reader into a USABLE form - Excel Worksheet or Access Table....

Thanks for the assistance! It is much appreciated!

Sean

[ fanpages ]

Hi Sean,

"Always waiting" is certainly easy to achieve but will somewhat tie-up the PC from doing other things.

I suggest you have a wait of 0.5 to 1.0 second whilst "polling" for the STX character so that other events in the operating system also have some of the CPU time.

...

So, if I understand what you need...

You start up your MS-Excel workbook, it waits on incoming data on COM1: & when an STX character is received, it then reads a fixed length of data bytes that is terminated by an ETX character. When the ETX has been received, the data is then transferred to a (local?) worksheet (in the same workbook) and/or written to an MS-Access table. The code then waits for the next STX character, and continues in the same manner.

Queries:
How do you wish to stop the "polling"?
Do you wish to save the workbook at a pre-defined number of reads (so that should there be a failure of any kind you do not lose the data that has been read)?
Also, if there was no waiting between the reads, and the data was being stored in the local workbook, you would not be able to use the workbook to review what had just been read.

Additionally...
What if an ETX (or a subsequent STX) character is within the fixed length of data? That is, if the data has been mis-read by the card swipe reader & it has not delivered the correct number of data bytes - how do you wish this fact to be known? And after a given number (three?) mis-reads do you wish to fall-back to manual data entry of the card number?

Finally...
Please advise on the name of the worksheet and column/row references where you would like the data to be stored after a read, &/or the database table/column details. And presumably you'll also need to know how to open & close a database in MS-Excel too :)

Should be an interesting project, and bring up many issues you hadn't realised existed (so far)...

BFN,

fp.

saladart

ASKER

You start up your MS-Excel workbook, it waits on incoming data on COM1: & when an STX character is received, it then reads a fixed length of data bytes that is terminated by an ETX character. When the ETX has been received, the data is then transferred to a (local?) worksheet (in the same workbook) and/or written to an MS-Access table. The code then waits for the next STX character, and continues in the same manner.

Yes to the above - I would like the data written to an Access Table and I can query the table from within Excel to get the data I need...

Queries:
How do you wish to stop the "polling"?
Via a STOP BUTTON somewhere. Also would like to start the polling via a START button...

Do you wish to save the workbook at a pre-defined number of reads (so that should there be a failure of any kind you do not lose the data that has been read)?

If the data is being imported into an Access Table, shouldn't be a problem. The Final product will be generated in Excel - I would like to use Access as the data repository to get customer information and product information from.

Also, if there was no waiting between the reads, and the data was being stored in the local workbook, you would not be able to use the workbook to review what had just been read.

True - after thinking it through last night (dreaming....) I thought if the data were being input into an Access table, I could simply perform an update on the Excel worksheet to get the most current imported data from Access and use it as I need. Does this sound corect to you?

What if an ETX (or a subsequent STX) character is within the fixed length of data? That is, if the data has been mis-read by the card swipe reader & it has not delivered the correct number of data bytes - how do you wish this fact to be known?

I would like to delete the record and scan the card again - if it keeps happening, I would want to manually input the information into the Access table - the customer with the card will be standing there waiting for me to scan the card so if there is a problem with his/her card, I can simply ask for the information and manually input it.

And after a given number (three?) mis-reads do you wish to fall-back to manual data entry of the card number?
Three sounds good to me.

Please advise on the name of the worksheet and column/row references where you would like the data to be stored after a read, &/or the database table/column details. And presumably you'll also need to know how to open & close a database in MS-Excel too :)
As I mentioned yesterday, I anticipate having the field information today (hopefully)...so I can not provide all of the information you will need at this time. I can, however, provide the name of the Access file and path: C:\trade shows\sales.mdb and the name of the table for the information to go that is being input from the card reader is named CUSTOMER. The workbook that will be referencing the data in the sales.mdb file is: C:\Trade Shows\Trade Show Invoice.xls. The worksheet that will be querying the CUSTOMER table in Access will be named CUSTOMERS.

As soon as I have the data string specification (fields and lengths) I will post them.

BTW - do you ever sleep? seems like you only slept maybe a few hours.... Not enough for me to function properly...

Take care and many thanks for your assist!

Sean

[ fanpages ]

:)

Thanks for coming back to me with what you have so far, Sean.

A few of us ("zorvek", for example) get by with very little sleep as we're too devoted to helping out as much as possible.

Or we have no lives, and are really geeky.

You decide :)

Everything you've mentioned makes sense as is certainly possible.

PS. What's the name of the column (field) within the [CUSTOMER] table you would like the card number to be scanned into?

And... why don't we consider writing the card scanning code in MS-Access, rather than MS-Excel? Just a thought...

"Speak" to you later.

BFN,

fp.

saladart

ASKER

What's the name of the column (field) within the [CUSTOMER] table you would like the card number to be scanned into?

The name of the field is CUSTID

BTW - I think I mentioned above that I would like to have Access be the place where the card scanning code is located - just maybe not in those words... I envisioned all of the scanned cards information being records within Access and using Excel to query the Access Database for the customer information...make sense?

BTW - people like myself appreciate the fact that "A few of us ("zorvek", for example) get by with very little sleep as we're too devoted to helping out as much as possible." In the event no one has said it before - MANY THANKS for being there...

Let me know what other info you will need...

Sean

[ fanpages ]

Hi Sean,

Thanks for confirming the column name. Sorry I must have missed your subtle suggestion that we put the code in MS-Access. You may recall I asked if you needed help with opening a database in Excel. Perhaps if I had been explicit... I was thinking that you would scan into Excel then write the data to the Access database (whilst remaining in Excel). At the time I didn't know whether you wanted the data in Excel or Access. But it's OK... I think we have that resolved now. The code will be in Access. After scanning the data will be placed in a database record. You will then handle the extract of records & import into Excel as you require them.

OK, outstanding queries:

* What is the (fixed) length of the data between STX & ETX?
* Do you wish to create new records in the database table, or update existing records?
* If existing records, I presume these will be "keyed" (stored) by Customer name (or number, or a unique identifier of some sort). Whilst scanning how will you indicate which Customer's details you wish to update? Or... is this scanning routine part of a large(r) EPoS piece of code that you already have written? (I guess so, as you have asked for a Start scanning, & Stop scanning, option).

...and you're very welcome for the help. If Kevin ("zorvek") was around on this topic, I'm sure he'd say the same.

BFN,

fp.

saladart

ASKER

Fanpages,

I have yet to get the data spec from the show coordinator...they say they will have it this afternoon (US - Central Time).

The best they can tell me (for now) is:

"Your custom application or operating environment should provide buffered communications on the serial port. Since the data block sent by the card reader is somewhat small in length, it does not support any type of handshaking. Your application should check the status of the serial port (or it's input buffer) and look for the reception of an STX character. This signals the start of transmission from the card reader. Once the STX has been received, it should read the data until an ETX character is received, which signals the end of transmission. The STX and ETX characters are not considered part of the data block and should be removed before processing the data block.

The datablock length is dependent on the type of card used at the show. The data block normally consists of 244 characters, but could be 500 or 2036 characters in length. Your application should allow for at least a 2K communication block."

I am hoping to get exact fields and field lengths this afternoon...

Hope this helps some...

Thanks again!

Sean

saladart

ASKER

I forgot to answer the other "querys"

Do you wish to create new records in the database table, or update existing records?

I wish to create new records in the table with the ability to manually update them as needed.

If existing records, I presume these will be "keyed" (stored) by Customer name (or number, or a unique identifier of some sort).

Yes - the unique Identifier will be the CUSTID field in the CUSTOMER TABLE.

Whilst scanning how will you indicate which Customer's details you wish to update? Or... is this scanning routine part of a large(r) EPoS piece of code that you already have written? (I guess so, as you have asked for a Start scanning, & Stop scanning, option).

Updates to a customer record can be made via an Access Form or directly in the CUSTOMER TABLE.

Sean

saladart

ASKER

OK - here is something to work on - it is last years data layout and he said that this years would not be very different - if different at all.

He states: I should have just given this to you before, but it’s last year’s layout. The contact info should be pretty similar, but the demographic codes (located at the bottom) will probably be different this year.

Here is the layout:

Field Field Name Description Type Width Start End
----- ---------- --------------------------- --------- ----- ----- ---
1 AAO041 Show Code Character 6 1 6
2 ID Attendee ID# Numeric 6.0 7 12
3 LASTNAME Last Name Character 25 13 37
4 FIRSTNAME First Name Character 20 38 57
5 MIDDLENAME Middle Initial Character 20 58 77
6 SUFFIX Suffix Character 30 78 107
7 COMPANY Company Character 35 108 142
8 COMPANY2 Company 2 Character 35 143 177
9 ADDRESS Address Character 40 178 217
10 ADDRESS2 Address 2 Character 40 218 257
11 CITY City Character 20 258 277
12 STATE State Character 50 278 327
13 ZIPCODE Zip Code Character 20 328 347
14 COUNTRY Country Character 50 348 397
15 PHONE Voice Phone # Character 20 398 417
16 FAX Fax # Character 20 418 437
17 REGTYPE Registration Type Character 10 438 447
18 EMAIL Email Address Character 60 448 507
19 MEMBERNBR Member # Character 20 508 527
20 CMEGLA CME GLA Flag Logical 1 528 528
21 CMEMAIN CME Main Flag Logical 1 529 529
22 CMENEU CME NEU Flag Logical 1 530 530
23 CMEREF CME REF Flag Logical 1 531 531
24 CMERET CME RET Flag Logical 1 532 532
25 CMEUVE CME UVE Flag Logical 1 533 533
26 DEGREE Degree Character 5 534 538
27 PRACTICE Type of Practice Character 10 539 548
28 SPEC Specialty Character 2 549 550

Let me know if you need anything else... When I get the spec for this year, I will post it as well...

Sean

saladart

ASKER

Fanpages - where art thou Fanpages??????

Not to put too much pressure on - I have a short deadline to get this done - like NLT Friday...and this piece is only one section of what I have to do...

Any assistance in finishing up will be greatly appreciated...

Sean

[ fanpages ]

I'm still here.

...But confused what field(s) from the input data go into the [CUSTOMER].[CUSTID] column.

I thought we were scanning a number. We now seem to be scanning up to 2k worth of data.

Yes, your vendor is correct... there seems to be the potential for a lot of work here.

BFN,

fp.

saladart

ASKER

Sorry for the confusion on what we are scanning.

What is being scanned is a string of data - that starts when the STX is received and ends when the ETX is received.

I finally got the FINAL input string specification. Here it is:

Field Field Name Description Type Width Start End
----- ---------- --------------------------- --------- ----- ----- ---
1 AAO051 Show Code Character 6 1 6
2 ID Attendee ID# Numeric 6.0 7 12
3 BADGECONST Badge Const Character 6 13 18
4 LASTNAME Last Name Character 20 19 38
5 FIRSTNAME First Name Character 15 39 53
6 MIDDLE Middle Initial Character 1 54 54
7 SUFFIX Suffix Character 5 55 59
8 COMPANY Company Character 30 60 89
9 COMPANY2 Company 2 Character 30 90 119
10 ADDRESS Address Character 40 120 159
11 ADDRESS2 Address 2 Character 40 160 199
12 CITY City Character 20 200 219
13 STATE State Character 2 220 221
14 ZIPCODE Zip Code Character 10 222 231
15 COUNTRY Country Character 30 232 261
16 PHONE Voice Phone # Character 20 262 281
17 FAX Fax # Character 20 282 301
18 REGTYPE Registration Type Character 10 302 311
19 EMAIL Email Address Character 60 312 371
20 CMEGLA CME GLA Flag Logical 1 372 372
21 CMEMAIN CME Main Flag Logical 1 373 373
22 CMENEU CME NEU Flag Logical 1 374 374
23 CMEREF CME REF Flag Logical 1 375 375
24 CMERET CME RET Flag Logical 1 376 376
25 CMEUVE CME UVE Flag Logical 1 377 377
26 CMEPED CME PED Flag Logival 1 378 378
27 PRACTICE Type of Practice Character 2 379 380
28 SPECIALT Specialty Character 10 381 390

Ends up that we are only inputting 390 characters.

from the input string, the second field (ID Attendee ID# Numeric 6.0 7 12) will be the data that goes into the [CUSTOMER].[CUSTID] field (I can rename the field to ID if needed). Assume that the ACCESS TABLE is constructed exactly like the above data spec that will be coming in from the card reader.

Hope this helps... If there are any other questions, please ask...

Thanks again!

Sean

saladart

ASKER

Fanpages,

If this is going to be more than you are willing to work with, please let me know as I am sitting here waiting on you...

I appreciate the assistance you have provided so far....and hope you will be able to continue - but at the same time, I will understand if you choose not to continue...

Respectfully,

Sean

Adam314

I'm not much of an access expert, but since you seem to be in a hurry i'll try....
Create a form with a button that runs this code... this will get 1 record. Maybe posting a pointer in the Access TA will help also...

Dim blnContinue As Boolean
Dim strInput As String

Open "COM1:9600,n,8,1" For Input As #1

blnContinue = True

While (blnContinue)

DoEvents()

Input #1, strInput

If Left$(strInput, 1) = Chr$(2) And _
Right$(strInput, 1) = Chr$(3) Then
'INSERT record here, get each field using mid function
'field[AAO051]=mid(strInput,1,6)
'field[ID]=mid(strInput,7,6)
'field[BADGECONST]=mid(strInput,13,6)

blnContinue = False
End If

Wend

Close #1

Hopefully this will be enough to get you going, or someone else knows more about access

[ fanpages ]

Everything's cool... I just got it into my head that you just wanted one field of data (the Customer ID) extracting from the data stream & subsequently writing to a single column in your database table. Hence my questions regarding how the record would be keyed. I didn't understand how I was to write a record that would make any sense if I only have one column within it. The splitting of the data bytes is relatively trival (using a User Defined Type, and the CopyMemory ["RtlMoveMemory"] API routine), so don't worry about that.

If I understand correctly (now)...

1. Click [Start] button.
2. Wait on COM1: for <STX>.
3. Read data bytes until <ETX> read.
4. If 390 bytes read, then INSERT a record splitting the 390 bytes into 28 separate columns.
5. If data bytes are not equal to 390, then re-try up to three times & drop to manual entry if re-tries exceeded.
6. Loop back to 2 until [Stop] button is clicked.

If you can confirm this is how you envisage the code working, or amend as necessary, I will provide something demonstrable to you later today (Thursday). It's now 00:30am in the UK.

BFN,

fp.

saladart

ASKER

Fanpages,

YES YES YES!!!!! We are now on the same page....i believe.

Let me ask you a question. Step 6 is loop back to step 2. Does this mean that multuple records can be imported before the stop button is clicked? That would be SUPER cool if it were the way it worked...

Step 4 - I have provided the lengths of the different fields above - I assume that the code will parse out the fields based on the lengths of each field - if that is true, we are on the same page.

Fanpages - I hope you can come through...Not so much for you, but there is a LOT riding on this on my side...not to mention what I will learn from it...INVALUABLE!

Thanks again!

Sean

[ fanpages ]

Hi Sean,

It's 10:15pm in the UK.

How long will you be able to read messages? For a few hours yet?

I will start coding in a short while & will post what I have for you to review & test the next time you have the opportunity. Note that I don't have a card reader, so a majority of the testing will have to fall to you :)

Re: Your queries above

Yes, Step 6 loops back to Step 2. Multiple records can be swiped by the card reader before [STOP] is clicked.

Step 4 - Yes, your file specification field lengths will be used to parse out into the database record columns.

Speak to you soon-ish.

BFN,

fp.

saladart

ASKER

I will be here for as long as you will work on this...

Sean

[ fanpages ]

Hi Sean,

E-E went down for a while there - phew! Back now.

Do you have the card reader in-hand at present, and does it present 390 data bytes as expected?

I'm just wondering if I can post some code to test I'm reading the data correctly, before I then complete it with the database record update.

?

BFN,

fp.

[ fanpages ]

(I'm testing by using a file on my hard drive as input, rather than serial communications port 1, so I am curious as to whether a data stream acts in the same file as physical file access)

[ fanpages ]

Also, could you supply the field names (columns) for your CUSTOMERS table?

Are the fields in the same order as defined in the data file, and does the table have any additional columns?

BFN,

fp.

saladart

ASKER

I have the card reader onsite - sitting on my desk.

The CUSTOMERS table is structured exactly like the spec I posted above - field names are the same with the same field lengths and no extra fields. Here they are for verification:

AAO051 TEXT 6
ID TEXT 6
BADGECONST TEXT 6
LASTNAME TEXT 20
FIRSTNAME TEXT 15
MIDDLE TEXT 1
SUFFIX TEXT 5
COMPANY TEXT 30
COMPANY2 TEXT 30
ADDRESS TEXT 40
ADDRESS2 TEXT 40
CITY TEXT 20
STATE TEXT 2
ZIPCODE TEXT 10
COUNTRY TEXT 30
PHONE TEXT 20
FAX TEXT 20
REGTYPE TEXT 10
EMAIL TEXT 60
CMEGLA TEXT 1
CMEMAIN TEXT 1
CMENEU TEXT 1
CMEREF TEXT 1
CMERET TEXT 1
CMEUVE TEXT 1
CMEPED TEXT 1
PRACTICE TEXT 2
SPECIALTY TEXT 10

Sean

[ fanpages ]

Thanks Sean.

Here's some MS-Access VBA code for pasting into a (global/public) code module.

If you run the Start_Scanning() routine, and swipe a card, if <STX><390 data bytes><ETX> is read successfully, a MsgBox will be displaying showing the 390 bytes.

Please try this & see if we have any issues with it. Note that it does not store the data yet:

Option Compare Database
Option Explicit

' ----------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Databases/MS Access
' Question Title: Setting VB code to listen on com port for input
' Question Asker: saladart
' Question Dated: 3 October 2005 11:44PM BST
' Question URL: https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
'
' Expert Comment: "fanpages"
' Copyright: (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' ----------------------------------------------------------------------------------------------

Dim blnScanning As Boolean
Dim hndCOM1 As Long

'Field Field Name Description Type Width Start End
'----- ---------- --------------------------- --------- ----- ----- ---
' 1 AAO051 Show Code Character 6 1 6
' 2 ID Attendee ID# Numeric 6.0 7 12
' 3 BADGECONST Badge Const Character 6 13 18
' 4 LASTNAME Last Name Character 20 19 38
' 5 FIRSTNAME First Name Character 15 39 53
' 6 MIDDLE Middle Initial Character 1 54 54
' 7 SUFFIX Suffix Character 5 55 59
' 8 COMPANY Company Character 30 60 89
' 9 COMPANY2 Company 2 Character 30 90 119
' 10 ADDRESS Address Character 40 120 159
' 11 ADDRESS2 Address 2 Character 40 160 199
' 12 CITY City Character 20 200 219
' 13 STATE State Character 2 220 221
' 14 ZIPCODE Zip Code Character 10 222 231
' 15 COUNTRY Country Character 30 232 261
' 16 PHONE Voice Phone # Character 20 262 281
' 17 FAX Fax # Character 20 282 301
' 18 REGTYPE Registration Type Character 10 302 311
' 19 EMAIL Email Address Character 60 312 371
' 20 CMEGLA CME GLA Flag Logical 1 372 372
' 21 CMEMAIN CME Main Flag Logical 1 373 373
' 22 CMENEU CME NEU Flag Logical 1 374 374
' 23 CMEREF CME REF Flag Logical 1 375 375
' 24 CMERET CME RET Flag Logical 1 376 376
' 25 CMEUVE CME UVE Flag Logical 1 377 377
' 26 CMEPED CME PED Flag Logical 1 378 378
' 27 PRACTICE Type of Practice Character 2 379 380
' 28 SPECIALT Speciality Character 10 381 390

Private Type udtData
strAAO051 As String * 6 ' Field 01
strID As String * 6 ' Field 02
strBadgeConst As String * 6 ' Field 03
strLast_Name As String * 20 ' Field 04
strFirst_Name As String * 15 ' Field 05
strMiddle As String * 1 ' Field 06
strSuffix As String * 5 ' Field 07
strCompany As String * 30 ' Field 08
strCompany2 As String * 30 ' Field 09
strAddress As String * 40 ' Field 10
strAddress2 As String * 40 ' Field 11
strCity As String * 20 ' Field 12
strState As String * 2 ' Field 13
strZipCode As String * 10 ' Field 14
strCountry As String * 30 ' Field 15
strVoice_Phone_Number As String * 20 ' Field 16
strFax_Number As String * 20 ' Field 17
strRegistration_Type As String * 10 ' Field 18
strEmail_Address As String * 60 ' Field 19
strCME_GLA_Flag As String * 1 ' Field 20
strCME_Main_Flag As String * 1 ' Field 21
strCME_NEU_Flag As String * 1 ' Field 22
strCME_REF_Flag As String * 1 ' Field 23
strCME_RET_Flag As String * 1 ' Field 24
strCME_UVE_Flag As String * 1 ' Field 25
strCME_PED_Flag As String * 1 ' Field 26
strType_of_Practice As String * 2 ' Field 27
strSpeciality As String * 10 ' Field 28
End Type
Public Sub Start_Scanning()

Dim blnRead As Boolean
Dim strData As String
Dim strInput As String * 1
Dim udtData As udtData

If (blnScanning) Then
Close #hndCOM1
End If

hndCOM1 = FreeFile

'Open "COM1:9600,n,8,1" For Input As #hndCOM1

blnScanning = True

While (blnScanning)

DoEvents

If (blnScanning) Then
If EOF(hndCOM1) Then
Seek #hndCOM1, 1
End If

If Not EOF(hndCOM1) Then
If Asc(strInput) <> 2 Then
strInput = Input(1, #hndCOM1)
End If
If Asc(strInput) = 2 Then
strData = ""
blnRead = Not (EOF(hndCOM1))

While (blnRead)
strInput = Input(1, #hndCOM1)

blnRead = (Asc(strInput) <> 2 And Asc(strInput) <> 3) And _
(Not (EOF(hndCOM1)))

If (blnRead) Then
strData = strData & strInput
End If
Wend

If Len(strData) = Len(udtData) And _
Asc(strInput) = 3 Then
MsgBox strData
End If
End If
End If
End If

Wend

Close #hndCOM1

End Sub
Public Sub Stop_Scanning()

blnScanning = False

End Sub

BFN,

fp.

[ fanpages ]

%)

Not forgetting to remove the comment character on the line:
'Open "COM1:9600,n,8,1" For Input As #hndCOM1

i.e. replace with
Open "COM1:9600,n,8,1" For Input As #hndCOM1

Ooops! :)

saladart

ASKER

Fanpages,

When I run the StartScanning() macro, I receive a runtime error '52' - Bad Filename Or Number.

It errors on the following line:

If EOF(hndCOM1) Then

Sean

saladart

ASKER

OK - got your post after I posted mine...

I started the code - it started without error - I scanned a card and it did nothing...cant get it to stop...not responding...

Had to kill ACCESS to get it to stop.

Sean

saladart

ASKER

To be more specific - I started the code in vb editor - I was prompted with the MACRO screen and I selected the STARTSCANNING() macro. Then I scanned the card and after that, the app hung.

Sean

[ fanpages ]

No, you didn't... use [CTRL]+[BREAK] to stop it :)

Do you have a copy of HyperTerminal on your PC ([Start] -> Programs / Accessories / Communications / HyperTerminal)?

Can you use this to monitor COM1: & scan the same card, then copy what HyperTerminal displays & paste back into a comment here?

Remember to set the COM1: parameters as you originally quoted:
"COM1 at 9600 baud with no parity, 8 data bits, and 1 stop bit"

And also turn "local echo" to 'on'.

BFN,

fp.

saladart

ASKER

AAO051680775680775SMITH BRADLEY TMD
WILLS EYE HOSPITAL
840 WALNUT ST STE 800 PHILADELPHIA PA19107-5109
2154403169 2155038088 MIT SMITHBRA
DLEYTHOMAS@MSN.COM NYNNNNNU X 098825

saladart

ASKER

BTW - I DID try CTRL-BREAK and it didn't stop it....

Sean

[ fanpages ]

Is that 390 bytes? I can't tell from how E-E has dropped the space characters from the end of the lines...

[ fanpages ]

PS. In case the application "hangs" again, try setting a break-point [F9] on the line:
If (blnScanning) Then

The code will then halt every time it attempts to read the COM1: data stream. You can then press [F8] to continue, or stop the code running if desired.

[ fanpages ]

PPS. When you post data in the future, you may wish to consider masking some personal details with X's, or similar :)

saladart

ASKER

I counted 394 characters....keystroking through each character in Hyperterm...

Sean

[ fanpages ]

If that's the case, then either the specification you received is incorrect, or the card scanner is not working correctly.

[ fanpages ]

Try pasting the text to a new MS-Word document & then viewing the "File" / "Properties" to display the character count.

saladart

ASKER

I put a breakpoint as you suggested. Started the code and scanned the card. I received no messages and was able to scan another card - but I got no msgbox....

Sean

[ fanpages ]

The MsgBox will only be displayed if 390 characters are read (excluding <STX> & <ETX>) as per the data specification you pasted above (as received from the card scanner vendor).

[ fanpages ]

PS. Need to sleep soon... is 01:30am already & I have to get up at 05:00am to leave for 'proper' work...

[ fanpages ]

The reason the application appeared to 'hang' was that it was repeatedly reading the data stream until exactly 390 characters were read between an <STX> & an <ETX> character.

If you create a UserForm with two Command Buttons; [Start] & [Stop], or rather "cmdStart_Scanning" & "cmdStop_Scanning", then this code will allow you to press the [Stop] button rather than having to kill Access:

Option Compare Database
Option Explicit
Private Sub cmdStart_Scanning_Click()

Call Start_Scanning

End Sub
Private Sub cmdStop_Scanning_Click()

Call Stop_Scanning

End Sub

BFN,

fp.

saladart

ASKER

Fanpages,

Go to bed...I will deal with the company that provided me the card that doesn't match the spec they provided...

I will post an update when I know something new...

Thanks for all you have done so far...

Sean

[ fanpages ]

No worries, Sean.

Catch up with you tomorrow, well, later today (for me)...

BFN,

fp.

saladart

ASKER

I have an idea...

Can you make the code read in whatever is between the STX and the ETX (regardless of the string length) and populate that information into one field in one record? So, each time an ETX is detected, a new record will be added for the next STX.

My thoughts are that I could then import that information into another table WITH the correct specs for each field (once I get the BONEHEADS to provide me the correct information OR a good working card). Kinda extra work, but my problem is I don't know how to get the data from the card reader into Access. I do, however, know how to extract data from within Access and manipulate it as I need...

This will be a stop gap measure that is workable from my perspective. I STILL would like to get the data directly into the appropriate fields from the card being scanned - but time is my enemy right now...

What are your thoughts?

Sean

[ fanpages ]

I'll be leaving for the day in less than half an hour, then will not be back online for another 7 hours (from now).

When does you day end (in terms of hours from now)?

BFN,

fp.

[ fanpages ]

Create a new table called [TEMPORARY] that has the following fields:

1)
Field Name: Date_Time
Data Type: Date/Time
Format: dd-mmm-yyyy hh:nn:ss
Indexed: Yes (No Duplicates) <- PRIMARY KEY

2)
Field Name: Data
Data Type: Memo
Format: <none - leave blank>
Indexed: No

Then change the above code to this...

Option Compare Database
Option Explicit

' ----------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Databases/MS Access
' Question Title: Setting VB code to listen on com port for input
' Question Asker: saladart
' Question Dated: 3 October 2005 11:44PM BST
' Question URL: https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
'
' Expert Comment: "fanpages"
' Copyright: (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' ----------------------------------------------------------------------------------------------

Dim blnScanning As Boolean
Dim hndCOM1 As Long

'Field Field Name Description Type Width Start End
'----- ---------- --------------------------- --------- ----- ----- ---
' 1 AAO051 Show Code Character 6 1 6
' 2 ID Attendee ID# Numeric 6.0 7 12
' 3 BADGECONST Badge Const Character 6 13 18
' 4 LASTNAME Last Name Character 20 19 38
' 5 FIRSTNAME First Name Character 15 39 53
' 6 MIDDLE Middle Initial Character 1 54 54
' 7 SUFFIX Suffix Character 5 55 59
' 8 COMPANY Company Character 30 60 89
' 9 COMPANY2 Company 2 Character 30 90 119
' 10 ADDRESS Address Character 40 120 159
' 11 ADDRESS2 Address 2 Character 40 160 199
' 12 CITY City Character 20 200 219
' 13 STATE State Character 2 220 221
' 14 ZIPCODE Zip Code Character 10 222 231
' 15 COUNTRY Country Character 30 232 261
' 16 PHONE Voice Phone # Character 20 262 281
' 17 FAX Fax # Character 20 282 301
' 18 REGTYPE Registration Type Character 10 302 311
' 19 EMAIL Email Address Character 60 312 371
' 20 CMEGLA CME GLA Flag Logical 1 372 372
' 21 CMEMAIN CME Main Flag Logical 1 373 373
' 22 CMENEU CME NEU Flag Logical 1 374 374
' 23 CMEREF CME REF Flag Logical 1 375 375
' 24 CMERET CME RET Flag Logical 1 376 376
' 25 CMEUVE CME UVE Flag Logical 1 377 377
' 26 CMEPED CME PED Flag Logical 1 378 378
' 27 PRACTICE Type of Practice Character 2 379 380
' 28 SPECIALT Speciality Character 10 381 390

Private Type udtData
strAAO051 As String * 6 ' Field 01
strID As String * 6 ' Field 02
strBadgeConst As String * 6 ' Field 03
strLast_Name As String * 20 ' Field 04
strFirst_Name As String * 15 ' Field 05
strMiddle As String * 1 ' Field 06
strSuffix As String * 5 ' Field 07
strCompany As String * 30 ' Field 08
strCompany2 As String * 30 ' Field 09
strAddress As String * 40 ' Field 10
strAddress2 As String * 40 ' Field 11
strCity As String * 20 ' Field 12
strState As String * 2 ' Field 13
strZipCode As String * 10 ' Field 14
strCountry As String * 30 ' Field 15
strVoice_Phone_Number As String * 20 ' Field 16
strFax_Number As String * 20 ' Field 17
strRegistration_Type As String * 10 ' Field 18
strEmail_Address As String * 60 ' Field 19
strCME_GLA_Flag As String * 1 ' Field 20
strCME_Main_Flag As String * 1 ' Field 21
strCME_NEU_Flag As String * 1 ' Field 22
strCME_REF_Flag As String * 1 ' Field 23
strCME_RET_Flag As String * 1 ' Field 24
strCME_UVE_Flag As String * 1 ' Field 25
strCME_PED_Flag As String * 1 ' Field 26
strType_of_Practice As String * 2 ' Field 27
strSpeciality As String * 10 ' Field 28
End Type
Public Sub Start_Scanning()

Dim blnRead As Boolean
Dim strData As String
Dim strInput As String * 1
Dim udtData As udtData

If (blnScanning) Then
Close #hndCOM1
End If

hndCOM1 = FreeFile

Open "COM1:9600,n,8,1" For Input As #hndCOM1

blnScanning = True

While (blnScanning)

DoEvents

If (blnScanning) Then
If EOF(hndCOM1) Then
Seek #hndCOM1, 1
End If

If Not EOF(hndCOM1) Then
If Asc(strInput) <> 2 Then
strInput = Input(1, #hndCOM1)
End If
If Asc(strInput) = 2 Then
strData = ""
blnRead = Not (EOF(hndCOM1))

While (blnRead)
strInput = Input(1, #hndCOM1)

blnRead = (Asc(strInput) <> 2 And Asc(strInput) <> 3) And _
(Not (EOF(hndCOM1)))

If (blnRead) Then
strData = strData & strInput
End If
Wend

' If Len(strData) = Len(udtData) And _
' Asc(strInput) = 3 Then
' MsgBox strData
' End If
If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
End If
End If
End If
End If

Wend

MsgBox "Closing..."

Close #hndCOM1

End Sub
Public Sub Stop_Scanning()

blnScanning = False

End Sub

Hope that helps.

BFN,

fp.

[ fanpages ]

The change was, btw...

Comment-out:
' If Len(strData) = Len(udtData) And _
' Asc(strInput) = 3 Then
' MsgBox strData
' End If

And add these lines directly after the commented-out lines:
If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
End If

:)

[ fanpages ]

Oh yes, and I added:
MsgBox "Closing..."

So you could tell when the scanning has stopped (after clicking the [Stop] button).

:)

saladart

ASKER

Fanpages,

After scanning several cards, the program appeared to come out of a HUNG state and the data was submitted into the MEMO field as expected...

I think I can work with this for now...

More later...

Thank you!

Sean

saladart

ASKER

Fanpages,

Using the above code, I am able to scan cards and the data is (eventually) imported to the TEMPORARY table.

What happens is I scan 1 card and Access stops responding. I Scan another card and still Access still doesn't respond. I cannot CTRL-BREAK in the code nor does the STOP button work. After scanning 2 or 3 more (there is no consistency), Access will become responsive again. Good thing - all of the records are in the Temporary table. Bad thing - I need to be able to get to the record after each scanned card - not all the time, but most of the time. Really, when the stop button is clicked, I need to be able to get to the record(s) that was just imported.

Any ideas as to why it would take so long for Access to become responsive?

Sean

saladart

ASKER

Let me update my previous statement. I thought that after several card scans Access became responsive again - not the case. I have to perform an END TASK (CTRL-ALT-DEL) to end it. GOOD NEWS, however, the records are in the table!!!!

Sean

Adam314

I have played around a little, and find that access appears to lockup also on my system using the above method. Maybe using the microsoft comm object will work better.

Whenever data is sent, an event is called. Rather than looping forever, your program will wait idle until data is received. See here for more details.

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/comm98/html/vbobjcomm.asp

saladart

ASKER

Adam314,
Being that I am novice at programming, can you implement the code into what Fanpages has already done?

Thanks

[ fanpages ]

Just passing before I go out for a few hours...

Before using the MSComm object, I can add code to pause for a second between scans to give you the opportunity to use Access, as I mentioned a few days ago, "I suggest you have a wait of 0.5 to 1.0 second whilst "polling" for the STX character so that other events in the operating system also have some of the CPU time".

Testing using flat files for input rather than the serial port does not cause a problem, so I have not seen the effect of hanging.

Which operating system & version of Access are you using, btw?

Will be back home in about 4.5 - 5 hours time...

Adam314

another thought... it might be that the properties for the COM port are not correct for the card reader. This line
Open "COM1:9600,n,8,1" For Input As #hndCOM1
opens at 9600 baud, no parity, 8 data bits, 1 stop bit. Are these the correct settings?

With the mscomm control:
I've never used the mscomm control, and have only very basic access experience - and on top of that I can't test the code (as i don't have the card reader)... but here goes a try. Run this code and let me know if you get a message box telling you the size and data whenever you scan a card. The object will also call the event whenever an error occurs, or status changes.... no code for any of those now, but maybe in the future.

create a form
create a "listen" button (name it "Listen" in properties window)
create a "stop listen" button (name it "StopListen" in properties window)

Option Compare Database
Dim MSComm1 As MSComm

Private Sub Listen_Click()
''''''''''Put this code in the "listen" button, the subroutine name will probably

If MSComm1.PortOpen Then MSComm1.PortOpen = False
' Use COM1.
MSComm1.CommPort = 1
' 9600 baud, no parity, 8 data, and 1 stop bit.
MSComm1.Settings = "9600,N,8,1"
' Tell the control to read entire buffer when Input
' is used.
MSComm1.InputLen = 0
'set RThreshold (number of chars that buffer can hold)
MSComm1.RThreshold = 2048
' Open the port.
MSComm1.PortOpen = True
End Sub

Private Sub MSComm1_OnComm()
Dim strInput As String
Select Case MSComm1.CommEvent
' Handle each event or error by placing
' code below each case statement

' Errors
Case comEventBreak ' A Break was received.
Case comEventFrame ' Framing Error
Case comEventOverrun ' Data Lost.
Case comEventRxOver ' Receive buffer overflow.
Case comEventRxParity ' Parity Error.
Case comEventTxFull ' Transmit buffer full.
Case comEventDCB ' Unexpected error retrieving DCB]

' Events
Case comEvCD ' Change in the CD line.
Case comEvCTS ' Change in the CTS line.
Case comEvDSR ' Change in the DSR line.
Case comEvRing ' Change in the Ring Indicator.
Case comEvSend ' There are SThreshold number of characters in the transmit buffer.
Case comEvEOF ' An EOF charater was found in the input stream

Case comEvReceive ' Received RThreshold # of chars.
strInput = MSComm1.Input
MsgBox "Received " & MSComm1.InBufferCount & " characters" & vbCrLf & strInput
'The data is now in strInput... i'm not sure how to get it into the DB though
End Select
End Sub

Private Sub StopListen_Click()
MSComm1.PortOpen = False
End Sub

saladart

ASKER

For Input As #hndCOM1
opens at 9600 baud, no parity, 8 data bits, 1 stop bit. Are these the correct settings?

These settings are correct.

I am going to eat lunch and when I return, will try out your attempt. I appreciate you giving it a shot....

Sean

Adam314

no problem... maybe i'll be able to get it to work, or maybe someone else will be able to finish it, using mine as a base. have a good lunch :)

saladart

ASKER

Adam314,

For some reason, I cannot get your code to run.

Let me go over what I did - maybe I did something incorrectly...

Created a new MDB - named TEST
Created a form named CardReaderStart_Stop. Created a command button on the form named LISTEN - in the ON CLICK event procedure, I put the code you put above.

Created a button named STOP and in the ON CLICK event procedure, I put the code you put above (Private Sub StopListen()).

I then inserted a new MODULE - named MODULE 1 - and put the below code in the module.
Private Sub MSComm1_OnComm()
Dim strInput As String
Select Case MSComm1.CommEvent
' Handle each event or error by placing
' code below each case statement

' Errors
Case comEventBreak ' A Break was received.
Case comEventFrame ' Framing Error
Case comEventOverrun ' Data Lost.
Case comEventRxOver ' Receive buffer overflow.
Case comEventRxParity ' Parity Error.
Case comEventTxFull ' Transmit buffer full.
Case comEventDCB ' Unexpected error retrieving DCB]

' Events
Case comEvCD ' Change in the CD line.
Case comEvCTS ' Change in the CTS line.
Case comEvDSR ' Change in the DSR line.
Case comEvRing ' Change in the Ring Indicator.
Case comEvSend ' There are SThreshold number of characters in the transmit buffer.
Case comEvEOF ' An EOF charater was found in the input stream

Case comEvReceive ' Received RThreshold # of chars.
strInput = MSComm1.Input
MsgBox "Received " & MSComm1.InBufferCount & " characters" & vbCrLf & strInput
'The data is now in strInput... i'm not sure how to get it into the DB though
End Select
End Sub

I found that I did not have the MSCOMM control installed on my computer. I downloaded it and have it installed and registered in Access.

What happens when I click the LISTEN button is:
"The expression On CLick you entered as the event property setting produced the following error:
User-defined type not defined."

I am betting that will be easy to fix - probably something I did incorrectly.

Sean

Adam314

I put all of this code in a form, didn't create any modules. There are two additional functions, the Form_load and Form_Unload (to create, destroy the mscomm object). I can click the start and stop buttons without any errors, but don't get any data. Give this a try....

new Form
add a button named Listen (it should call Listen_Click when clicked)
add a button named StopListen (it should call StopListen_Click when clicked)
go to the code for the form. copy/paste the below code.

Option Compare Database
Dim MSComm1 As MSComm

Private Sub Form_Load()
Set MSComm1 = New MSComm

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set MSComm1 = Nothing
End Sub

Private Sub Listen_Click()
''''''''''Put this code in the "listen" button, the subroutine name will probably

If MSComm1.PortOpen Then MSComm1.PortOpen = False
' Use COM1.
MSComm1.CommPort = 1
' 9600 baud, no parity, 8 data, and 1 stop bit.
MSComm1.Settings = "9600,N,8,1"
' Tell the control to read entire buffer when Input
' is used.
MSComm1.InputLen = 0
'set RThreshold (number of chars that buffer can hold)
MSComm1.RThreshold = 2048
' Open the port.
MSComm1.PortOpen = True
End Sub

Private Sub MSComm1_OnComm()
Dim strInput As String
Select Case MSComm1.CommEvent
' Handle each event or error by placing
' code below each case statement

' Errors
Case comEventBreak ' A Break was received.
Case comEventFrame ' Framing Error
Case comEventOverrun ' Data Lost.
Case comEventRxOver ' Receive buffer overflow.
Case comEventRxParity ' Parity Error.
Case comEventTxFull ' Transmit buffer full.
Case comEventDCB ' Unexpected error retrieving DCB]

' Events
Case comEvCD ' Change in the CD line.
Case comEvCTS ' Change in the CTS line.
Case comEvDSR ' Change in the DSR line.
Case comEvRing ' Change in the Ring Indicator.
Case comEvSend ' There are SThreshold number of characters in the transmit buffer.
Case comEvEOF ' An EOF charater was found in the input stream

Case comEvReceive ' Received RThreshold # of chars.
strInput = MSComm1.Input
MsgBox "Received " & MSComm1.InBufferCount & " characters" & vbCrLf & strInput
'The data is now in strInput... i'm not sure how to get it into the DB though
End Select
End Sub

Private Sub StopListen_Click()
MSComm1.PortOpen = False
End Sub

[ fanpages ]

(12midnight, UK time)

How are we doing, guys?

Do you need me to put in a timer within my code, or is the MSComm ActiveX Object working?

BFN,

fp.

saladart

ASKER

I can't get it to work....

HELP!!!!!!

saladart

ASKER

I followed the instructions - I am receving the following message when I try to run:

The Expression On Load you entered as the event property setting produced the following error:
User-Defined type not defined.

I have loaded the MSCOMM32.ocx and made sure that the REFERENCES that I think are needed are enabled and at the top of the list...

I need help....

Sean

saladart

ASKER

Fanpages - I am willing to try the timer if you think it will work...

[ fanpages ]

Just looking for my previously written code relating to the Timer.

It's literally been 15 years since I used the MSComm control (in VB 3.0) & it was a nightmare then - I hope it's improved since if we do have to revert to using it.

With post again in a few minutes...

[ fanpages ]

Try this...

(Note the lines I have marked ' *** ADDED)

Option Compare Database
Option Explicit

' ----------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Databases/MS Access
' Question Title: Setting VB code to listen on com port for input
' Question Asker: saladart
' Question Dated: 3 October 2005 11:44PM BST
' Question URL: https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
'
' Expert Comment: "fanpages"
' Copyright: (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' ----------------------------------------------------------------------------------------------

Dim blnScanning As Boolean
Dim hndCOM1 As Long

'Field Field Name Description Type Width Start End
'----- ---------- --------------------------- --------- ----- ----- ---
' 1 AAO051 Show Code Character 6 1 6
' 2 ID Attendee ID# Numeric 6.0 7 12
' 3 BADGECONST Badge Const Character 6 13 18
' 4 LASTNAME Last Name Character 20 19 38
' 5 FIRSTNAME First Name Character 15 39 53
' 6 MIDDLE Middle Initial Character 1 54 54
' 7 SUFFIX Suffix Character 5 55 59
' 8 COMPANY Company Character 30 60 89
' 9 COMPANY2 Company 2 Character 30 90 119
' 10 ADDRESS Address Character 40 120 159
' 11 ADDRESS2 Address 2 Character 40 160 199
' 12 CITY City Character 20 200 219
' 13 STATE State Character 2 220 221
' 14 ZIPCODE Zip Code Character 10 222 231
' 15 COUNTRY Country Character 30 232 261
' 16 PHONE Voice Phone # Character 20 262 281
' 17 FAX Fax # Character 20 282 301
' 18 REGTYPE Registration Type Character 10 302 311
' 19 EMAIL Email Address Character 60 312 371
' 20 CMEGLA CME GLA Flag Logical 1 372 372
' 21 CMEMAIN CME Main Flag Logical 1 373 373
' 22 CMENEU CME NEU Flag Logical 1 374 374
' 23 CMEREF CME REF Flag Logical 1 375 375
' 24 CMERET CME RET Flag Logical 1 376 376
' 25 CMEUVE CME UVE Flag Logical 1 377 377
' 26 CMEPED CME PED Flag Logical 1 378 378
' 27 PRACTICE Type of Practice Character 2 379 380
' 28 SPECIALT Speciality Character 10 381 390

Private Type udtData
strAAO051 As String * 6 ' Field 01
strID As String * 6 ' Field 02
strBadgeConst As String * 6 ' Field 03
strLast_Name As String * 20 ' Field 04
strFirst_Name As String * 15 ' Field 05
strMiddle As String * 1 ' Field 06
strSuffix As String * 5 ' Field 07
strCompany As String * 30 ' Field 08
strCompany2 As String * 30 ' Field 09
strAddress As String * 40 ' Field 10
strAddress2 As String * 40 ' Field 11
strCity As String * 20 ' Field 12
strState As String * 2 ' Field 13
strZipCode As String * 10 ' Field 14
strCountry As String * 30 ' Field 15
strVoice_Phone_Number As String * 20 ' Field 16
strFax_Number As String * 20 ' Field 17
strRegistration_Type As String * 10 ' Field 18
strEmail_Address As String * 60 ' Field 19
strCME_GLA_Flag As String * 1 ' Field 20
strCME_Main_Flag As String * 1 ' Field 21
strCME_NEU_Flag As String * 1 ' Field 22
strCME_REF_Flag As String * 1 ' Field 23
strCME_RET_Flag As String * 1 ' Field 24
strCME_UVE_Flag As String * 1 ' Field 25
strCME_PED_Flag As String * 1 ' Field 26
strType_of_Practice As String * 2 ' Field 27
strSpeciality As String * 10 ' Field 28
End Type

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' *** ADDED
Public Sub Start_Scanning()

Dim blnRead As Boolean
Dim strData As String
Dim strInput As String * 1
Dim udtData As udtData

If (blnScanning) Then
Close #hndCOM1
End If

hndCOM1 = FreeFile

Open "COM1:9600,n,8,1" For Input As #hndCOM1

blnScanning = True

While (blnScanning)

DoEvents
Call Sleep(1000&) ' *** ADDED
DoEvents ' *** ADDED

If (blnScanning) Then
If EOF(hndCOM1) Then
Seek #hndCOM1, 1
End If

If Not EOF(hndCOM1) Then
If Asc(strInput) <> 2 Then
strInput = Input(1, #hndCOM1)
End If
If Asc(strInput) = 2 Then
strData = ""
blnRead = Not (EOF(hndCOM1))

While (blnRead)
DoEvents ' *** ADDED

strInput = Input(1, #hndCOM1)

blnRead = (Asc(strInput) <> 2 And Asc(strInput) <> 3) And _
(Not (EOF(hndCOM1)))

If (blnRead) Then
strData = strData & strInput
End If
Wend

' If Len(strData) = Len(udtData) And _
' Asc(strInput) = 3 Then
' MsgBox strData
' End If
If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
End If
End If
End If
End If

Wend

MsgBox "Closing..."

Close #hndCOM1

End Sub
Public Sub Stop_Scanning()

blnScanning = False

End Sub

BFN,

fp.

[ fanpages ]

This isn't the "wait" (sleep) routine I was aiming to find, but it should do the trick & allow Access to be more responsive.

I'll continue searching through my code archives for what I did intend(ed) to find, just in case...

saladart

ASKER

Fanpages,

ACPERKINS helped some in the VB area - decided he didn't want to get into it any further than he did.

Here is the post...https://www.experts-exchange.com/questions/21585242/VB-Script-gives-a-COMPILE-ERROR-need-assistance-figuring-out-why.html

Maybe what he has started - you may make sense and hopefuly you may be able to help make it work...

I see that it is worth a shot...

Sean

[ fanpages ]

I think the other contributor was just adding value to how to write to a database record using ActiveX Data Objects.

We may come back to that - but for now, please try my last suggestion.

I have now found the "Pause" routine I was looking for, and will post another code listing in a moment using that so you can try that as well to see if Access responds any better.

saladart

ASKER

I no longer get the HANGING situation I was getting before. I also get the message when I click the stop scanning button.

BUT - no records are going into the TEMPORARY table....

Sean

[ fanpages ]

Here you are...

This code doesn't use the "Sleep()" API routine, but uses a 'stub' routine instead.

"Sleep()" causes the application to literally "go to sleep" for a specified number of milliseconds (1000, or 1 second, in the code above). No other event in Access will occur whilst in this state.

The 'stub' (Pause) routine I have replaced it with, still waits a second, but allows other events in Access to be processed; for example, key presses & mouse clicks.

Option Compare Database
Option Explicit

' ----------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Databases/MS Access
' Question Title: Setting VB code to listen on com port for input
' Question Asker: saladart
' Question Dated: 3 October 2005 11:44PM BST
' Question URL: https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
'
' Expert Comment: "fanpages"
' Copyright: (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' ----------------------------------------------------------------------------------------------

Dim blnScanning As Boolean
Dim hndCOM1 As Long

'Field Field Name Description Type Width Start End
'----- ---------- --------------------------- --------- ----- ----- ---
' 1 AAO051 Show Code Character 6 1 6
' 2 ID Attendee ID# Numeric 6.0 7 12
' 3 BADGECONST Badge Const Character 6 13 18
' 4 LASTNAME Last Name Character 20 19 38
' 5 FIRSTNAME First Name Character 15 39 53
' 6 MIDDLE Middle Initial Character 1 54 54
' 7 SUFFIX Suffix Character 5 55 59
' 8 COMPANY Company Character 30 60 89
' 9 COMPANY2 Company 2 Character 30 90 119
' 10 ADDRESS Address Character 40 120 159
' 11 ADDRESS2 Address 2 Character 40 160 199
' 12 CITY City Character 20 200 219
' 13 STATE State Character 2 220 221
' 14 ZIPCODE Zip Code Character 10 222 231
' 15 COUNTRY Country Character 30 232 261
' 16 PHONE Voice Phone # Character 20 262 281
' 17 FAX Fax # Character 20 282 301
' 18 REGTYPE Registration Type Character 10 302 311
' 19 EMAIL Email Address Character 60 312 371
' 20 CMEGLA CME GLA Flag Logical 1 372 372
' 21 CMEMAIN CME Main Flag Logical 1 373 373
' 22 CMENEU CME NEU Flag Logical 1 374 374
' 23 CMEREF CME REF Flag Logical 1 375 375
' 24 CMERET CME RET Flag Logical 1 376 376
' 25 CMEUVE CME UVE Flag Logical 1 377 377
' 26 CMEPED CME PED Flag Logical 1 378 378
' 27 PRACTICE Type of Practice Character 2 379 380
' 28 SPECIALT Speciality Character 10 381 390

Private Type udtData
strAAO051 As String * 6 ' Field 01
strID As String * 6 ' Field 02
strBadgeConst As String * 6 ' Field 03
strLast_Name As String * 20 ' Field 04
strFirst_Name As String * 15 ' Field 05
strMiddle As String * 1 ' Field 06
strSuffix As String * 5 ' Field 07
strCompany As String * 30 ' Field 08
strCompany2 As String * 30 ' Field 09
strAddress As String * 40 ' Field 10
strAddress2 As String * 40 ' Field 11
strCity As String * 20 ' Field 12
strState As String * 2 ' Field 13
strZipCode As String * 10 ' Field 14
strCountry As String * 30 ' Field 15
strVoice_Phone_Number As String * 20 ' Field 16
strFax_Number As String * 20 ' Field 17
strRegistration_Type As String * 10 ' Field 18
strEmail_Address As String * 60 ' Field 19
strCME_GLA_Flag As String * 1 ' Field 20
strCME_Main_Flag As String * 1 ' Field 21
strCME_NEU_Flag As String * 1 ' Field 22
strCME_REF_Flag As String * 1 ' Field 23
strCME_RET_Flag As String * 1 ' Field 24
strCME_UVE_Flag As String * 1 ' Field 25
strCME_PED_Flag As String * 1 ' Field 26
strType_of_Practice As String * 2 ' Field 27
strSpeciality As String * 10 ' Field 28
End Type
'Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' Now using Stub to Pause() subroutine
Public Sub Start_Scanning()

Dim blnRead As Boolean
Dim strData As String
Dim strInput As String * 1
Dim udtData As udtData

If (blnScanning) Then
Close #hndCOM1
End If

hndCOM1 = FreeFile

Open "COM1:9600,n,8,1" For Input As #hndCOM1

blnScanning = True

While (blnScanning)

DoEvents
Call Sleep(1000&)
DoEvents

If (blnScanning) Then
If EOF(hndCOM1) Then
Seek #hndCOM1, 1
End If

If Not EOF(hndCOM1) Then
If Asc(strInput) <> 2 Then
strInput = Input(1, #hndCOM1)
End If
If Asc(strInput) = 2 Then
strData = ""
blnRead = Not (EOF(hndCOM1))

While (blnRead)
DoEvents

strInput = Input(1, #hndCOM1)

blnRead = (Asc(strInput) <> 2 And Asc(strInput) <> 3) And _
(Not (EOF(hndCOM1)))

If (blnRead) Then
strData = strData & strInput
End If
Wend

' If Len(strData) = Len(udtData) And _
' Asc(strInput) = 3 Then
' MsgBox strData
' End If
If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
End If
End If
End If
End If

Wend

MsgBox "Closing..."

Close #hndCOM1

End Sub
Public Sub Stop_Scanning()

blnScanning = False

End Sub
Private Function Sleep(ByVal lngMilliseconds As Long)

' Stub routine to call Pause() instead of "Sleep()" API...

Call Pause(CDbl(lngMilliseconds / 1000&))

End Function
Private Function dblTimeStamp(Optional ByVal dblSeconds As Double = 0) As Double

On Error Resume Next

dblTimeStamp = CDbl(Int(Now()) + (Timer + dblSeconds) / 86400) ' 86400 = 60 seconds * 60 minutes * 24 hours

End Function
Private Sub Pause(ByVal dblSeconds As Double)

Dim blnWend As Boolean
Dim dblTime As Double

dblTime = dblTimeStamp(dblSeconds)

blnWend = (dblTimeStamp >= dblTime)

While Not (blnWend)

DoEvents

blnWend = (dblTimeStamp >= dblTime) Or Not (blnScanning)

Wend

End Sub

BFN,

fp.

[ fanpages ]

Re: Your last posting.

I suspect putting the application to "sleep" has meant that we have missed the data coming into the COM1: port completely.

If you are still using the code with the "Sleep()" API routine, try reducing the Millisecond count from 1000 down to 500, or 300.

That is, lines:
DoEvents
Call Sleep(1000&)
DoEvents

Replace with
DoEvents
Call Sleep(500&) ' etc.
DoEvents

Nearly there by the sounds of it... :)

Adam314

Was out for a bit... back now.

If you want to try the MSComm....
On your control toolbox (eg: the toolbar used to add buttons, etc.), is there a mscomm object? You might have to click the 'more' (hammer, wrench with ... on it), and in the list select "Microsoft Communication Control, version 6.0" (the version might be different, 6.0 is what I have). The control should have to be added to the form, but this would show it is loaded correctly.

saladart

ASKER

I took the Call Sleep(1000&) down to 300 and still not getting any records in the TEMPORARY table...

Sean

[ fanpages ]

Hi Adam,

Whilst Sean is away trying some stuff... I thought I'd just respond to something you asked earlier regarding the port settings (baud rate, parity, number of data bits, & number of stop bits).

If these were not set correctly for the scanner then we would never receive any data at all. Sean certainly would not have been able to see incoming data in his HyperTerminal session if any of these attributes were incorrectly defined.

Thanks for helping out, btw... I know Sean's desperate to see the back of this work.

Let's see how my recent code suggestions go before we introduce the MSComm Control, as it will be somewhat more radical re-working of the code that could potential be working at present once we've establish the correct "sleep" interval.

BFN,

fp.

saladart

ASKER

Just to ensure that there was no communication issue - I did a scan through Hyperterminal and I did get a good card scan...

Sean

[ fanpages ]

Sean - did you try my second listing using the 'Stub' routine (in place of the "Sleep()" API)?

[ fanpages ]

(Still here... but getting tired... it's now 01:30am in good ol' Blighty)

saladart

ASKER

Yes - I recopied your last set of code and ran it - it now is hanging BUT the records are being input into the TEJMPORARY table.. I am having to CTRL-ALT-DEL and end task to get out...

Sean

[ fanpages ]

All this talk of Sleep() I should imagine! ;)

Or perhaps it's the 3.5 hours of Kickboxing training I've done tonight.

Either way... Zzzzzz...

[ fanpages ]

I really don't understand why you need to 3-finger-salute Access.

The calls to DoEvents should allow enough processing time to intercept the [CTRL]+[BREAK] key combination.

OK... with the 'stub' version of the code, what's the value inside the call to the Sleep(<parameter>) routine?

saladart

ASKER

It was 1000 - I just took it to 500. When I recopied, I didn't change it back down...stand by for results..

Sean

saladart

ASKER

Still locks up - I will take it down to 300 and try...

Adam314

On my machine, without having any data on the port, it will hang at either of these lines. (i guess i understand why the input is hanging, but i would have thought EOF to just return TRUE if there was no data...)
EOF(hndCOM1)
strInput = Input(1, #hndCOM1)

anyways, i found this by single stepping the code (F8), line by line. Maybe saladart can try the same to see if these are the lines it hangs on, and then once it's hanging, try scanning a card and see if the hanging stops.

saladart

ASKER

New finding - as soon as I start it, it locks up..... I tried starting it and forgot to change the Sleep parameter to 300 so I tried to stop it - it was hung without scanning...

Sean

[ fanpages ]

It shouldn't lock up with the higher value (1000)... setting this lower will make matters worse.

Try a higher value (5000 i.e. 5 seconds) - you may find cards do not read 100% of the time, but it will give us an indication if we are going up a comedy cul-de-sac.

PS. I asked earlier what Windows O/S & version of MS-Access you were using.

This may have relevance to this issue.

Adam314

P.S. my system is winXP, access 2002

saladart

ASKER

EOF(hndCOM1)

Stepping through as Adam did, Access stopped responding at the same point... EOF(hndCOM1)

Sean

[ fanpages ]

Sorry which line does it stop at?

There's a few references to EOF(hndCOM1).

Adam314

did it respond if you then scanned a card? (i couldn't test this step)

saladart

ASKER

I am running XP SP2 with Office 2K Pro

Will up the sleep number to 1000 and see what happens...

Sean

saladart

ASKER

I tried it with 1000 and with 1500 - both numbers caused Access to become non responsive. I could, however, close it without the 3 finger salute...

I will try starting - then scanning a card - will post results...

Sean

[ fanpages ]

Hmmm... I wonder if during the Sleep() [stub] routine, the card details are still being read via the COM1: port... May have to set a boolean variable to indicate that sleeping is in progress, so that the main body of the code doesn't process any more data during that time.

Damn! I wish I had a serial port & a card reader. Debugging hardware issues can be remotely difficult [pun intended].

saladart

ASKER

OK - Starting the app - I scanned one card - Access not responding. I scanned another card and saw that there was a brief moment of activity right after the scan. I scanned another card - noticed the brief (about 1 second) activity at the computer.

On a hunch, I scanned another and placed the cursor on the stop button - in that brief period, I was able to click the stop button and regained control of the application (Access).

Sean

[ fanpages ]

Code with my last suggestion to ignore scanning data stream whilst sleeping...

Option Compare Database
Option Explicit

' ----------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Databases/MS Access
' Question Title: Setting VB code to listen on com port for input
' Question Asker: saladart
' Question Dated: 3 October 2005 11:44PM BST
' Question URL: https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
'
' Expert Comment: "fanpages"
' Copyright: (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' ----------------------------------------------------------------------------------------------

Dim blnScanning As Boolean
Dim blnSleeping As Boolean
Dim hndCOM1 As Long

'Field Field Name Description Type Width Start End
'----- ---------- --------------------------- --------- ----- ----- ---
' 1 AAO051 Show Code Character 6 1 6
' 2 ID Attendee ID# Numeric 6.0 7 12
' 3 BADGECONST Badge Const Character 6 13 18
' 4 LASTNAME Last Name Character 20 19 38
' 5 FIRSTNAME First Name Character 15 39 53
' 6 MIDDLE Middle Initial Character 1 54 54
' 7 SUFFIX Suffix Character 5 55 59
' 8 COMPANY Company Character 30 60 89
' 9 COMPANY2 Company 2 Character 30 90 119
' 10 ADDRESS Address Character 40 120 159
' 11 ADDRESS2 Address 2 Character 40 160 199
' 12 CITY City Character 20 200 219
' 13 STATE State Character 2 220 221
' 14 ZIPCODE Zip Code Character 10 222 231
' 15 COUNTRY Country Character 30 232 261
' 16 PHONE Voice Phone # Character 20 262 281
' 17 FAX Fax # Character 20 282 301
' 18 REGTYPE Registration Type Character 10 302 311
' 19 EMAIL Email Address Character 60 312 371
' 20 CMEGLA CME GLA Flag Logical 1 372 372
' 21 CMEMAIN CME Main Flag Logical 1 373 373
' 22 CMENEU CME NEU Flag Logical 1 374 374
' 23 CMEREF CME REF Flag Logical 1 375 375
' 24 CMERET CME RET Flag Logical 1 376 376
' 25 CMEUVE CME UVE Flag Logical 1 377 377
' 26 CMEPED CME PED Flag Logical 1 378 378
' 27 PRACTICE Type of Practice Character 2 379 380
' 28 SPECIALT Speciality Character 10 381 390

Private Type udtData
strAAO051 As String * 6 ' Field 01
strID As String * 6 ' Field 02
strBadgeConst As String * 6 ' Field 03
strLast_Name As String * 20 ' Field 04
strFirst_Name As String * 15 ' Field 05
strMiddle As String * 1 ' Field 06
strSuffix As String * 5 ' Field 07
strCompany As String * 30 ' Field 08
strCompany2 As String * 30 ' Field 09
strAddress As String * 40 ' Field 10
strAddress2 As String * 40 ' Field 11
strCity As String * 20 ' Field 12
strState As String * 2 ' Field 13
strZipCode As String * 10 ' Field 14
strCountry As String * 30 ' Field 15
strVoice_Phone_Number As String * 20 ' Field 16
strFax_Number As String * 20 ' Field 17
strRegistration_Type As String * 10 ' Field 18
strEmail_Address As String * 60 ' Field 19
strCME_GLA_Flag As String * 1 ' Field 20
strCME_Main_Flag As String * 1 ' Field 21
strCME_NEU_Flag As String * 1 ' Field 22
strCME_REF_Flag As String * 1 ' Field 23
strCME_RET_Flag As String * 1 ' Field 24
strCME_UVE_Flag As String * 1 ' Field 25
strCME_PED_Flag As String * 1 ' Field 26
strType_of_Practice As String * 2 ' Field 27
strSpeciality As String * 10 ' Field 28
End Type
'Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' Now using Stub to Pause() subroutine
Public Sub Start_Scanning()

Dim blnRead As Boolean
Dim strData As String
Dim strInput As String * 1
Dim udtData As udtData

blnSleeping = False

If (blnScanning) Then
Close #hndCOM1
End If

hndCOM1 = FreeFile

Open "COM1:9600,n,8,1" For Input As #hndCOM1

blnScanning = True

While (blnScanning)

DoEvents
Call Sleep(1000&)
DoEvents

If (blnScanning) And Not (blnSleeping) Then
If EOF(hndCOM1) Then
Seek #hndCOM1, 1
End If

If Not EOF(hndCOM1) Then
If Asc(strInput) <> 2 Then
strInput = Input(1, #hndCOM1)
End If
If Asc(strInput) = 2 Then
strData = ""
blnRead = Not (EOF(hndCOM1))

While (blnRead)
DoEvents

strInput = Input(1, #hndCOM1)

blnRead = (Asc(strInput) <> 2 And Asc(strInput) <> 3) And _
(Not (EOF(hndCOM1)))

If (blnRead) Then
strData = strData & strInput
End If
Wend

' If Len(strData) = Len(udtData) And _
' Asc(strInput) = 3 Then
' MsgBox strData
' End If
If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
End If
End If
End If
End If

Wend

MsgBox "Closing..."

Close #hndCOM1

End Sub
Public Sub Stop_Scanning()

blnScanning = False
blnSleeping = False

End Sub
Private Function Sleep(ByVal lngMilliseconds As Long)

' Stub routine to call Pause() instead of "Sleep()" API...

blnSleeping = True
Call Pause(CDbl(lngMilliseconds / 1000&))
blnSleeping = False

End Function
Private Function dblTimeStamp(Optional ByVal dblSeconds As Double = 0#) As Double

On Error Resume Next

dblTimeStamp = CDbl(Int(Now()) + (Timer + dblSeconds) / 86400) ' 86400 = 60 seconds * 60 minutes * 24 hours

End Function
Private Sub Pause(ByVal dblSeconds As Double)

Dim blnWend As Boolean
Dim dblTime As Double

dblTime = dblTimeStamp(dblSeconds)

blnWend = (dblTimeStamp >= dblTime)

While Not (blnWend)

DoEvents

blnWend = (dblTimeStamp >= dblTime) Or Not (blnScanning)

Wend

End Sub

BFN,

fp.

[ fanpages ]

Just read your last comment.

Please try my latest code suggestion above.

The card reader must be causing the COM1: port stream to halt when no data is incoming.

The EOF() check must not return True if the end of data has been reached, but it must just wait indefinitely.

When you speak with the card reader vendor (next week?) please could you ask them for any technical documentation they have on this hardware? It may help us understand what the hell it is doing (or not).

Thanks.

saladart

ASKER

Put your last code post in and got the same results as my last post:

OK - Starting the app - I scanned one card - Access not responding. I scanned another card and saw that there was a brief moment of activity right after the scan. I scanned another card - noticed the brief (about 1 second) activity at the computer.

On a hunch, I scanned another and placed the cursor on the stop button - in that brief period, I was able to click the stop button and regained control of the application (Access).

Sean

saladart

ASKER

They did say that the scanner is not doing ANY handshaking - and that the code should be looking for the STX and ETX characters...

You can bet that I will be chatting with them next week...

Sean

[ fanpages ]

Did the [TEMPORARY] table contain the correct number of records (and was the data complete)?

Adam314

fanpages: if you run the code, what happens when access gets to the EOF line? does it return TRUE right away?

[ fanpages ]

:)

Yup, the lack of handshaking would cause this problem.

Basically, the card scanner controls the flow of data, the PC cannot query whether any data remains in the input stream.

We may need to rethink the coding strategy.

The MSComm control would probably struggle here also [but I'm willing to be proven wrong] :(

Adam314

it's about the end of the day for me here.... and i won't be able to respond until middle of next week.

Best of luck, and if it's not resolved by my return, i'll see if I can help - but i think you already have more experienced help here.

saladart

ASKER

Yes-the records are being posted into the TEMPORARY table...and they were complete.

Sean

[ fanpages ]

Hi Adam,

I'm not using Serial port input [as I don't have one on this laptop!], I'm reading from an ASCII file on my C:\ drive so, yes, EOF() does return True or False, as expected.

Nuts.

saladart

ASKER

Adam - thank you for your attempts...Hopefully, if nothing else, you learned something from it...

Take care and again, Thank you!
Sean

[ fanpages ]

Thanks Adam. Hopefully we'll catch up in a few days. Yes, it's 02:10am in the UK now. I should really be doing something else! %)

Sean - Can you live with the application as it is until we can discuss further with the vendor? Can you experiment with the parameter value inside the call to the Sleep() function?

How quickly do you scan cards? What's the throughput rate?

saladart

ASKER

Fanpages - if you can't thnk of anything else, let's call it a night. Maybe you will wake up in the middle of a deep sleep and remember something that will at the time seem SUPER OBVIOUS - then you will not sleep the rest of the night because of missing the obvious....:~)

If something comes up over the weekend, I will be monitoring this post - feel free to suggest things to try. I am going to take the card scanner and workstation home with me...maybe with it being in the house, I will awake from a deep sleep and realize the obvious overlooked detail...and myself, won't go back to sleep....out of frustration...

Let me know if you are calling it quits now...I will stay as long as you will...

Sean

saladart

ASKER

To answer your last query - How quickly do you scan cards? - From the time I insert the card and pull it out, about 2 seconds. The throughput rate - assuming you mean between the card reader and the computer - 9600baud...

Sean

[ fanpages ]

Hi Sean,

I'd like to be able to suggest something new, but I'm really now in the dark as to whether the card reader is going to be able to be controlled in the manner we have been attempting.

I will think on this over the weekend, though.

Of course, the quick fix is to only allow the scanning of one card at a time, and not to make the process loop back waiting for the next card so you'd have to press [Start Scanning] every time.

If you wish to try this...

If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
blnScanning = False ' *** ADD THIS LINE
End If

I'll stick around for a few minutes longer.

I'm just sorry we didn't manage to meet your deadline :(

BFN,

fp.

[ fanpages ]

Sorry... no, by "throughput rate" I meant how many cards do you scan per minute/hour/etc.

saladart

ASKER

The throughput rate varies - anywhere from 10 to 50 per hour...so in thegrand scheme of things, not too many...

Where do I need to post the code - in a new module or as an addition to your other code?

Sean

Adam314

one last comment: If you can get the MSComm to read data without hanging, then the rest (eg: parsing and inserting into DB) shouldn't be hard.

From the documentation (not tested), the object will call the OnComm event whenever data is received... and here (with no hardware), if i tell it to "wait" for data, it doesn't hang while waiting.

saladart

ASKER

Adam - IAm all ears...

Can you provide an example of what you are referring to (code)?

Sean

saladart

ASKER

Im not too proud to admit - I am in over my head with this one...:~)

[ fanpages ]

"Where do I need to post the code - in a new module or as an addition to your other code?"

Look for the existing lines:

If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
End If

And insert the marked line so that the three lines become four, thus:

If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
blnScanning = False ' *** ADD THIS LINE
End If

If it helps, the whole code listing with the additional line is...

Option Compare Database
Option Explicit

' ----------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Databases/MS Access
' Question Title: Setting VB code to listen on com port for input
' Question Asker: saladart
' Question Dated: 3 October 2005 11:44PM BST
' Question URL: https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
'
' Expert Comment: "fanpages"
' Copyright: (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' ----------------------------------------------------------------------------------------------

Dim blnScanning As Boolean
Dim blnSleeping As Boolean
Dim hndCOM1 As Long

'Field Field Name Description Type Width Start End
'----- ---------- --------------------------- --------- ----- ----- ---
' 1 AAO051 Show Code Character 6 1 6
' 2 ID Attendee ID# Numeric 6.0 7 12
' 3 BADGECONST Badge Const Character 6 13 18
' 4 LASTNAME Last Name Character 20 19 38
' 5 FIRSTNAME First Name Character 15 39 53
' 6 MIDDLE Middle Initial Character 1 54 54
' 7 SUFFIX Suffix Character 5 55 59
' 8 COMPANY Company Character 30 60 89
' 9 COMPANY2 Company 2 Character 30 90 119
' 10 ADDRESS Address Character 40 120 159
' 11 ADDRESS2 Address 2 Character 40 160 199
' 12 CITY City Character 20 200 219
' 13 STATE State Character 2 220 221
' 14 ZIPCODE Zip Code Character 10 222 231
' 15 COUNTRY Country Character 30 232 261
' 16 PHONE Voice Phone # Character 20 262 281
' 17 FAX Fax # Character 20 282 301
' 18 REGTYPE Registration Type Character 10 302 311
' 19 EMAIL Email Address Character 60 312 371
' 20 CMEGLA CME GLA Flag Logical 1 372 372
' 21 CMEMAIN CME Main Flag Logical 1 373 373
' 22 CMENEU CME NEU Flag Logical 1 374 374
' 23 CMEREF CME REF Flag Logical 1 375 375
' 24 CMERET CME RET Flag Logical 1 376 376
' 25 CMEUVE CME UVE Flag Logical 1 377 377
' 26 CMEPED CME PED Flag Logical 1 378 378
' 27 PRACTICE Type of Practice Character 2 379 380
' 28 SPECIALT Speciality Character 10 381 390

Private Type udtData
strAAO051 As String * 6 ' Field 01
strID As String * 6 ' Field 02
strBadgeConst As String * 6 ' Field 03
strLast_Name As String * 20 ' Field 04
strFirst_Name As String * 15 ' Field 05
strMiddle As String * 1 ' Field 06
strSuffix As String * 5 ' Field 07
strCompany As String * 30 ' Field 08
strCompany2 As String * 30 ' Field 09
strAddress As String * 40 ' Field 10
strAddress2 As String * 40 ' Field 11
strCity As String * 20 ' Field 12
strState As String * 2 ' Field 13
strZipCode As String * 10 ' Field 14
strCountry As String * 30 ' Field 15
strVoice_Phone_Number As String * 20 ' Field 16
strFax_Number As String * 20 ' Field 17
strRegistration_Type As String * 10 ' Field 18
strEmail_Address As String * 60 ' Field 19
strCME_GLA_Flag As String * 1 ' Field 20
strCME_Main_Flag As String * 1 ' Field 21
strCME_NEU_Flag As String * 1 ' Field 22
strCME_REF_Flag As String * 1 ' Field 23
strCME_RET_Flag As String * 1 ' Field 24
strCME_UVE_Flag As String * 1 ' Field 25
strCME_PED_Flag As String * 1 ' Field 26
strType_of_Practice As String * 2 ' Field 27
strSpeciality As String * 10 ' Field 28
End Type
'Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' Now using Stub to Pause() subroutine
Public Sub Start_Scanning()

Dim blnRead As Boolean
Dim strData As String
Dim strInput As String * 1
Dim udtData As udtData

blnSleeping = False

If (blnScanning) Then
Close #hndCOM1
End If

hndCOM1 = FreeFile

Open "COM1:9600,n,8,1" For Input As #hndCOM1

blnScanning = True

While (blnScanning)

DoEvents
Call Sleep(1000&)
DoEvents

If (blnScanning) And Not (blnSleeping) Then
If EOF(hndCOM1) Then
Seek #hndCOM1, 1
End If

If Not EOF(hndCOM1) Then
If Asc(strInput) <> 2 Then
strInput = Input(1, #hndCOM1)
End If
If Asc(strInput) = 2 Then
strData = ""
blnRead = Not (EOF(hndCOM1))

While (blnRead)
DoEvents

strInput = Input(1, #hndCOM1)

blnRead = (Asc(strInput) <> 2 And Asc(strInput) <> 3) And _
(Not (EOF(hndCOM1)))

If (blnRead) Then
strData = strData & strInput
End If
Wend

' If Len(strData) = Len(udtData) And _
' Asc(strInput) = 3 Then
' MsgBox strData
' End If
If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
blnScanning = False ' *** ADD THIS LINE
End If
End If
End If
End If

Wend

MsgBox "Closing..."

Close #hndCOM1

End Sub
Public Sub Stop_Scanning()

blnScanning = False
blnSleeping = False

End Sub
Private Function Sleep(ByVal lngMilliseconds As Long)

' Stub routine to call Pause() instead of "Sleep()" API...

blnSleeping = True
Call Pause(CDbl(lngMilliseconds / 1000&))
blnSleeping = False

End Function
Private Function dblTimeStamp(Optional ByVal dblSeconds As Double = 0#) As Double

On Error Resume Next

dblTimeStamp = CDbl(Int(Now()) + (Timer + dblSeconds) / 86400) ' 86400 = 60 seconds * 60 minutes * 24 hours

End Function
Private Sub Pause(ByVal dblSeconds As Double)

Dim blnWend As Boolean
Dim dblTime As Double

dblTime = dblTimeStamp(dblSeconds)

blnWend = (dblTimeStamp >= dblTime)

While Not (blnWend)

DoEvents

blnWend = (dblTimeStamp >= dblTime) Or Not (blnScanning)

Wend

End Sub

:)

saladart

ASKER

Fanpages - it errors out on If Asc(strInput) = 3 Then - gives Compile Error - invalid outside parameter...

saladart

ASKER

Not parameter - procedure...sorry...

[ fanpages ]

Go for it, Adam...

If you don't have the time to complete, or if it doesn't actually work as expected, then at least Sean has the fall-back of my last posting.

I'm about for another 5 minutes or so... then I really must get some Zzzz's.

Let me know what you intend to do, and if I have the opportunity this weekend I can look at revising the code to use the MSComm control.

Thanks again, Adam.

And, of course, thanks (really) Sean. This certainly beats the normal mundane "can you tell me how to create a formula" questions.

BFN,

fp.

saladart

ASKER

The thanks go to you two - especially you Fanpages. You have put some time into this and I can't thank you enough for your time.

Adam - like I said before, thank you for at least trying...hopefully, you can think of another way that will work.

I'll hang around until I hear back from both of you saying you're calling it a night...

Sean

[ fanpages ]

Hi,

Did you try the last revised code listing?

It should allow the scan of one card then not wait for another.

I will be retiring now. But should inspiration (rather than perspiration) hit me over the weekend, I'll look at the MSComm control... but obviously I still don't have the hardware or a serial port... so the testing will have to be up to you next week.

Have a good weekend, both of you, and no doubt we'll catch-up early next week.

'Night all...

BFN,

fp.

saladart

ASKER

FANPAGES - making progress...

I have to scan two cards - but the code doesn't lock up and it pops up the message Closing after the second card is scanned.

Only one record is posted to the table....

Sean

[ fanpages ]

Try reducing the Sleep(<parameter>) again, or removing that line completely.

I am reallly switching this machine off now, so see you nex................

saladart

ASKER

I remarked the line out completely and I still have to scan the card 2 times for it to take.

I know you are sleeping now - just wanted to let you know the results - in the event you look at this over the weekend...

Sean

Adam314

Here is the code using the mscomm object... i don't have the object installed on this machine, so i'll have to do that before i can test much more.
create a form with 2 buttons, named "Listen" and "StopListen"
go to the code for the form, and copy/paste this code. Click the listen button, then scan a card.... every time you scan, you should get a message box. click the stoplisten button when done. I'll check the post a few more times tonight, but then that'll be all until next week.

let us know how this goes.....

*****CODE*****
Option Compare Database

Dim MSComm1 As MSComm

Private Sub Detail_Click()

End Sub

Private Sub Form_Load()
Set MSComm1 = New MSComm

End Sub

Private Sub Form_Unload(Cancel As Integer)
Set MSComm1 = Nothing
End Sub

Private Sub Listen_Click()
''''''''''Put this code in the "listen" button, the subroutine name will probably

If MSComm1.PortOpen Then MSComm1.PortOpen = False
' Use COM1.
MSComm1.CommPort = 1
' 9600 baud, no parity, 8 data, and 1 stop bit.
MSComm1.Settings = "9600,N,8,1"
' Tell the control to read entire buffer when Input
' is used.
MSComm1.InputLen = 0
'set RThreshold (number of chars that buffer can hold)
MSComm1.RThreshold = 2048
' Open the port.
MSComm1.PortOpen = True
End Sub

Private Sub MSComm1_OnComm()
Dim strInput As String
Select Case MSComm1.CommEvent
' Handle each event or error by placing
' code below each case statement

' Errors
Case comEventBreak ' A Break was received.
Case comEventFrame ' Framing Error
Case comEventOverrun ' Data Lost.
Case comEventRxOver ' Receive buffer overflow.
Case comEventRxParity ' Parity Error.
Case comEventTxFull ' Transmit buffer full.
Case comEventDCB ' Unexpected error retrieving DCB]

' Events
Case comEvCD ' Change in the CD line.
Case comEvCTS ' Change in the CTS line.
Case comEvDSR ' Change in the DSR line.
Case comEvRing ' Change in the Ring Indicator.
Case comEvSend ' There are SThreshold number of characters in the transmit buffer.
Case comEvEOF ' An EOF charater was found in the input stream

Case comEvReceive ' Received RThreshold # of chars.
strInput = MSComm1.Input
MsgBox "Received " & MSComm1.InBufferCount & " characters" & vbCrLf & strInput
'The data is now in strInput... i'm not sure how to get it into the DB though
End Select
End Sub

Private Sub StopListen_Click()
MSComm1.PortOpen = False
End Sub

saladart

ASKER

Fanpages - if you are around, I would like to see if you could spend just a little more time on this - getting the code to accept the data string on the first scan - not have to scan the card 2 times...

Sean

[ fanpages ]

I will be around for a few minutes.

Please post the code you are now currently using so I can investigate in your absence (tomorrow).

BFN,

fp.

saladart

ASKER

Sorry I didn't get this posted yesterday - busy...

Here is the code:

Option Compare Database
Option Explicit

' ----------------------------------------------------------------------------------------------
' Experts Exchange
'
' Question Channel: Home/All Topics/Databases/MS Access
' Question Title: Setting VB code to listen on com port for input
' Question Asker: saladart
' Question Dated: 3 October 2005 11:44PM BST
' Question URL: https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
'
' Expert Comment: "fanpages"
' Copyright: (c) 2005 Clearlogic Concepts (UK) Limited / N.Lee [ http://NigelLee.info ]
' ----------------------------------------------------------------------------------------------

Dim blnScanning As Boolean
Dim blnSleeping As Boolean
Dim hndCOM1 As Long

'Field Field Name Description Type Width Start End
'----- ---------- --------------------------- --------- ----- ----- ---
' 1 AAO051 Show Code Character 6 1 6
' 2 ID Attendee ID# Numeric 6.0 7 12
' 3 BADGECONST Badge Const Character 6 13 18
' 4 LASTNAME Last Name Character 20 19 38
' 5 FIRSTNAME First Name Character 15 39 53
' 6 MIDDLE Middle Initial Character 1 54 54
' 7 SUFFIX Suffix Character 5 55 59
' 8 COMPANY Company Character 30 60 89
' 9 COMPANY2 Company 2 Character 30 90 119
' 10 ADDRESS Address Character 40 120 159
' 11 ADDRESS2 Address 2 Character 40 160 199
' 12 CITY City Character 20 200 219
' 13 STATE State Character 2 220 221
' 14 ZIPCODE Zip Code Character 10 222 231
' 15 COUNTRY Country Character 30 232 261
' 16 PHONE Voice Phone # Character 20 262 281
' 17 FAX Fax # Character 20 282 301
' 18 REGTYPE Registration Type Character 10 302 311
' 19 EMAIL Email Address Character 60 312 371
' 20 CMEGLA CME GLA Flag Logical 1 372 372
' 21 CMEMAIN CME Main Flag Logical 1 373 373
' 22 CMENEU CME NEU Flag Logical 1 374 374
' 23 CMEREF CME REF Flag Logical 1 375 375
' 24 CMERET CME RET Flag Logical 1 376 376
' 25 CMEUVE CME UVE Flag Logical 1 377 377
' 26 CMEPED CME PED Flag Logical 1 378 378
' 27 PRACTICE Type of Practice Character 2 379 380
' 28 SPECIALT Speciality Character 10 381 390

Private Type udtData
strAAO051 As String * 6 ' Field 01
strID As String * 6 ' Field 02
strBadgeConst As String * 6 ' Field 03
strLast_Name As String * 20 ' Field 04
strFirst_Name As String * 15 ' Field 05
strMiddle As String * 1 ' Field 06
strSuffix As String * 5 ' Field 07
strCompany As String * 30 ' Field 08
strCompany2 As String * 30 ' Field 09
strAddress As String * 40 ' Field 10
strAddress2 As String * 40 ' Field 11
strCity As String * 20 ' Field 12
strState As String * 2 ' Field 13
strZipCode As String * 10 ' Field 14
strCountry As String * 30 ' Field 15
strVoice_Phone_Number As String * 20 ' Field 16
strFax_Number As String * 20 ' Field 17
strRegistration_Type As String * 10 ' Field 18
strEmail_Address As String * 60 ' Field 19
strCME_GLA_Flag As String * 1 ' Field 20
strCME_Main_Flag As String * 1 ' Field 21
strCME_NEU_Flag As String * 1 ' Field 22
strCME_REF_Flag As String * 1 ' Field 23
strCME_RET_Flag As String * 1 ' Field 24
strCME_UVE_Flag As String * 1 ' Field 25
strCME_PED_Flag As String * 1 ' Field 26
strType_of_Practice As String * 2 ' Field 27
strSpeciality As String * 10 ' Field 28
End Type
'Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' Now using Stub to Pause() subroutine
Public Sub Start_Scanning()

Dim blnRead As Boolean
Dim strData As String
Dim strInput As String * 1
Dim udtData As udtData

blnSleeping = False

If (blnScanning) Then
Close #hndCOM1
End If

hndCOM1 = FreeFile

Open "COM1:9600,n,8,1" For Input As #hndCOM1

blnScanning = True

While (blnScanning)

'DoEvents
'Call Sleep(100&)
'DoEvents

If (blnScanning) And Not (blnSleeping) Then
If EOF(hndCOM1) Then
Seek #hndCOM1, 1
End If

If Not EOF(hndCOM1) Then
If Asc(strInput) <> 2 Then
strInput = Input(1, #hndCOM1)
End If
If Asc(strInput) = 2 Then
strData = ""
blnRead = Not (EOF(hndCOM1))

While (blnRead)
DoEvents

strInput = Input(1, #hndCOM1)

blnRead = (Asc(strInput) <> 2 And Asc(strInput) <> 3) And _
(Not (EOF(hndCOM1)))

If (blnRead) Then
strData = strData & strInput
End If
Wend

' If Len(strData) = Len(udtData) And _
' Asc(strInput) = 3 Then
' MsgBox strData
' End If
If Asc(strInput) = 3 Then
CurrentDb.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)
blnScanning = False ' *** ADD THIS LINE
End If
End If
End If
End If

Wend

MsgBox "Closing..."

Close #hndCOM1

End Sub
Public Sub Stop_Scanning()

blnScanning = False
blnSleeping = False

End Sub
Private Function Sleep(ByVal lngMilliseconds As Long)

' Stub routine to call Pause() instead of "Sleep()" API...

blnSleeping = True
Call Pause(CDbl(lngMilliseconds / 1000&))
blnSleeping = False

End Function
Private Function dblTimeStamp(Optional ByVal dblSeconds As Double = 0#) As Double

On Error Resume Next

dblTimeStamp = CDbl(Int(Now()) + (Timer + dblSeconds) / 86400) ' 86400 = 60 seconds * 60 minutes * 24 hours

End Function
Private Sub Pause(ByVal dblSeconds As Double)

Dim blnWend As Boolean
Dim dblTime As Double

dblTime = dblTimeStamp(dblSeconds)

blnWend = (dblTimeStamp >= dblTime)

While Not (blnWend)

DoEvents

blnWend = (dblTimeStamp >= dblTime) Or Not (blnScanning)

Wend

End Sub

Thanks for your assistance - I appreciate it more than you can imagine!

Sean

[ fanpages ]

Presently busy myself... but this should improve by the time I get home (in 4-5 hours time).

If I miss you again today, I'll try to post something before you're back online again.

PS. How did you get on with discussions with the hardware vendor, re: the 390/394 byte issue?

You're very welcome for my help. I'm just sorry it can't be any more useful/quicker due to region issues & lack of hardware at my side.

BFN,

fp.

saladart

ASKER

The vendor has insured me that the data spec is correct - the cards just were not programmed correctly... The cards are (according to the vendor) supposedly going to be 390 characters in length... I say ASSUME that the data string will be 390 characters in length and the fields are as originally defined.

I will be at the show tomorrow - AND will be able to send/receive email and will have access to Experts-Exchange - so, I can work with you as you find time AND I find time...

Many thanks!

Sean

saladart

ASKER

Fanpages,
I am back online...just to let you know...

Sean

saladart

ASKER

I am at the show - having to scan cards 2 times.....sure would be nice if I only had to scan them once...:~)

Sean

[ fanpages ]

I wonder if the first STX (ASCII Chr 2) is being missed everytime?

How long do you wait before swiping the card after clicking the [Start Scanning] button?

[ fanpages ]

I doubt you will, but I'll ask anyway... do you have access to a Protocol Analyser so you can see exactly what is passing from the card reader to the serial port?

I think I asked earlier; apologies if I did... If your vendor has a technical specification document for the card reader, including the data communications record layout, I would welcome a copy for background reading.

saladart

ASKER

I have waited anywhere from 2 seconds up to 5 minutes - same result always. Don't get me wrong - it is workable as it is now. It just would be ideal to not have to scan the card 2 times...

No on the protocol analyser....

The card reader is a Galaxy ExpoCard card reader.... The people here at the show don't know much about the device - they just know what it is and what it can do...go figure...

I can see a good scan via Hyperterminal - on the first scan - if that tells you anything... And it looks like the same information is being scanned both times I did the scan via Hyperterminal...

Whatever you can do to try to get it to one scan will be graciously appreciated...

Thanks Fanpages!
Sean

saladart

ASKER

Fanpages,

Being that you have worked this issue for so long, I wanted to award you more points. I have opened another post:
https://www.experts-exchange.com/questions/21595092/Capturing-a-data-string-from-Serial-Port-COM1-requires-scanning-the-card-2-times.html

Please continue there so you can get more points...

Thanks for your help so far...

Sean

[ fanpages ]

That's very kind of you, Sean, but the Topic Area moderator may have something to say about allocating more than 500 points to one question, given that it's not been answered to your satisfaction.

saladart

ASKER

Fanpages,

Here is how I see it - I can scan a card and get data into an access database - my original request...

I have to scan the card 2 times but "the original request has been met". The other post is to get the scanning to one time - instead of 2.

You have earned the 500 points already...in my opinion, you deserve more than the 500 for what you have done so far.

Sean

[ fanpages ]

:)

I'd sooner get a finished result that functions as you wish, but I appreciate your kind comments.

[ fanpages ]

Hi,

Create a UserForm in your MS-Excel workbook file, and add two Command Buttons, "cmdStart" & "cmdEnd", and a List-Box, "lstData". Name this UserForm "frmScanning".

In the code module for this form, add the following code:

' Start of code...

Option Explicit
' ----------------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Applications \ MS Office \ Excel
' https://www.experts-exchange.com/questions/21595178/Can-an-Access-Form-be-opened-and-used-within-Excel.html
' Can an Access Form be opened and used within Excel
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 4 October 2005 to 16 October 2005
' ----------------------------------------------------------------------------------
' See also...
' https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
' Setting VB code to listen on com port for input
' ----------------------------------------------------------------------------------
' and...
' https://www.experts-exchange.com/questions/21595092/Capturing-a-data-string-from-Serial-Port-COM1-requires-scanning-the-card-2-times.html
' Capturing a data string from Serial Port (COM1) requires scanning the card 2 times
' ----------------------------------------------------------------------------------

Dim blnScanning As Boolean
Dim blnSleeping As Boolean
Dim hndCOM1 As Long

'Field Field Name Description Type Width Start End
'----- ---------- --------------------------- --------- ----- ----- ---
' 1 AAO051 Show Code Character 6 1 6
' 2 ID Attendee ID# Numeric 6.0 7 12
' 3 BADGECONST Badge Const Character 6 13 18
' 4 LASTNAME Last Name Character 20 19 38
' 5 FIRSTNAME First Name Character 15 39 53
' 6 MIDDLE Middle Initial Character 1 54 54
' 7 SUFFIX Suffix Character 5 55 59
' 8 COMPANY Company Character 30 60 89
' 9 COMPANY2 Company 2 Character 30 90 119
' 10 ADDRESS Address Character 40 120 159
' 11 ADDRESS2 Address 2 Character 40 160 199
' 12 CITY City Character 20 200 219
' 13 STATE State Character 2 220 221
' 14 ZIPCODE Zip Code Character 10 222 231
' 15 COUNTRY Country Character 30 232 261
' 16 PHONE Voice Phone # Character 20 262 281
' 17 FAX Fax # Character 20 282 301
' 18 REGTYPE Registration Type Character 10 302 311
' 19 EMAIL Email Address Character 60 312 371
' 20 CMEGLA CME GLA Flag Logical 1 372 372
' 21 CMEMAIN CME Main Flag Logical 1 373 373
' 22 CMENEU CME NEU Flag Logical 1 374 374
' 23 CMEREF CME REF Flag Logical 1 375 375
' 24 CMERET CME RET Flag Logical 1 376 376
' 25 CMEUVE CME UVE Flag Logical 1 377 377
' 26 CMEPED CME PED Flag Logical 1 378 378
' 27 PRACTICE Type of Practice Character 2 379 380
' 28 SPECIALT Speciality Character 10 381 390

Private Type udtData
strAAO051 As String * 6 ' Field 01
strID As String * 6 ' Field 02
strBadgeConst As String * 6 ' Field 03
strLast_Name As String * 20 ' Field 04
strFirst_Name As String * 15 ' Field 05
strMiddle As String * 1 ' Field 06
strSuffix As String * 5 ' Field 07
strCompany As String * 30 ' Field 08
strCompany2 As String * 30 ' Field 09
strAddress As String * 40 ' Field 10
strAddress2 As String * 40 ' Field 11
strCity As String * 20 ' Field 12
strState As String * 2 ' Field 13
strZipCode As String * 10 ' Field 14
strCountry As String * 30 ' Field 15
strVoice_Phone_Number As String * 20 ' Field 16
strFax_Number As String * 20 ' Field 17
strRegistration_Type As String * 10 ' Field 18
strEmail_Address As String * 60 ' Field 19
strCME_GLA_Flag As String * 1 ' Field 20
strCME_Main_Flag As String * 1 ' Field 21
strCME_NEU_Flag As String * 1 ' Field 22
strCME_REF_Flag As String * 1 ' Field 23
strCME_RET_Flag As String * 1 ' Field 24
strCME_UVE_Flag As String * 1 ' Field 25
strCME_PED_Flag As String * 1 ' Field 26
strType_of_Practice As String * 2 ' Field 27
strSpeciality As String * 10 ' Field 28
End Type
'Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) ' Now using Stub to Pause() subroutine
Private Sub Start_Scanning()

Dim blnRead As Boolean
Dim strData As String
Dim strInput As String * 1
Dim udtData As udtData

On Error GoTo Err_Start_Scanning

blnSleeping = False

If (blnScanning) Then
Close #hndCOM1
End If

hndCOM1 = FreeFile

Open "COM1:9600,n,8,1" For Input As #hndCOM1

blnScanning = True

While (blnScanning)

DoEvents
Call Sleep(500&)
DoEvents

If (blnScanning) And Not (blnSleeping) Then
If EOF(hndCOM1) Then
Seek #hndCOM1, 1
End If

If Not EOF(hndCOM1) Then
If Asc(strInput) <> 2 Then
strInput = Input(1, #hndCOM1)
End If
If Asc(strInput) = 2 Then
strData = ""
blnRead = Not (EOF(hndCOM1))

While (blnRead)
DoEvents

strInput = Input(1, #hndCOM1)

blnRead = (Asc(strInput) <> 2 And Asc(strInput) <> 3) And _
(Not (EOF(hndCOM1)))

If (blnRead) Then
strData = strData & strInput
End If
Wend

' If Len(strData) = Len(udtData) And _
' Asc(strInput) = 3 Then
If Asc(strInput) = 3 Then
Me.lstData.AddItem strData, 0&
Me.lstData.ListIndex = 0&

dbCustomers.Execute "INSERT INTO [TEMPORARY] ([Date_Time], [Data]) " & _
"SELECT #" & Format$(Now, "dd-mmm-yyyy hh:nn:ss") & "#," & Chr$(34) & strData & Chr$(34)

dbEngine.Idle lngDAO_dbRefreshCache
End If
End If
End If
End If

Wend

Exit_Start_Scanning:

On Error Resume Next

Beep

If hndCOM1 <> 0& Then
Close #hndCOM1
End If

Exit Sub

Err_Start_Scanning:

MsgBox "Error #" & CStr(Err.Number) & _
vbCrLf & vbLf & _
Err.Description, _
vbExclamation Or vbOKOnly, _
ActiveWorkbook.Name

Resume Exit_Start_Scanning

End Sub
Private Sub Stop_Scanning()

On Error Resume Next

blnScanning = False
blnSleeping = False

End Sub
Private Function Sleep(ByVal lngMilliseconds As Long)

' Stub routine to call Pause() instead of "Sleep()" API...

On Error Resume Next

blnSleeping = True
Call Pause(CDbl(lngMilliseconds / 1000&))
blnSleeping = False

End Function
Private Function dblTimeStamp(Optional ByVal dblSeconds As Double = 0#) As Double

On Error Resume Next

dblTimeStamp = CDbl(Int(Now()) + (Timer + dblSeconds) / 86400) ' 86400 = 60 seconds * 60 minutes * 24 hours

End Function
Private Sub Pause(ByVal dblSeconds As Double)

Dim blnWend As Boolean
Dim dblTime As Double

On Error Resume Next

dblTime = dblTimeStamp(dblSeconds)

blnWend = (dblTimeStamp >= dblTime)

While Not (blnWend)

DoEvents

blnWend = (dblTimeStamp >= dblTime) Or Not (blnScanning)

Wend

End Sub
Private Sub cmdStart_Click()

On Error Resume Next

Me.cmdStart.Enabled = False
Me.cmdStop.Enabled = True

Call Start_Scanning

End Sub
Private Sub cmdStop_Click()

On Error Resume Next

Call Stop_Scanning

Me.cmdStart.Enabled = True
Me.cmdStop.Enabled = False

End Sub
Private Sub UserForm_Activate()

Me.cmdStart.Enabled = True
Me.cmdStop.Enabled = False
Me.lstData.Clear

End Sub

' ...End of code

Now, in the Workbook code module, add this code...

' Start of code...

Option Explicit
' ----------------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Applications \ MS Office \ Excel
' https://www.experts-exchange.com/questions/21595178/Can-an-Access-Form-be-opened-and-used-within-Excel.html
' Can an Access Form be opened and used within Excel
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 4 October 2005 to 16 October 2005
' ----------------------------------------------------------------------------------
' See also...
' https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
' Setting VB code to listen on com port for input
' ----------------------------------------------------------------------------------
' and...
' https://www.experts-exchange.com/questions/21595092/Capturing-a-data-string-from-Serial-Port-COM1-requires-scanning-the-card-2-times.html
' Capturing a data string from Serial Port (COM1) requires scanning the card 2 times
' ----------------------------------------------------------------------------------

Private Type udtMEMORY_STATUS
lngLength As Long
lngMemory_Load As Long
lngTotal_Physical As Long
lngAvailable_Physical As Long
lngTotal_Page_File As Long
lngAvailable_Page_File As Long
lngTotal_Virtual As Long
lngAvailable_Virtual As Long
End Type

Private Declare Sub GlobalMemoryStatus _
Lib "kernel32" _
(ByRef lpBuffer As udtMEMORY_STATUS)
Private Sub Workbook_BeforeClose(Cancel As Boolean)

If (blnDatabase_Open) Then
If Not (dbCustomers Is Nothing) Then
dbCustomers.Close
Set dbCustomers = Nothing
End If

If Not (wsCustomers Is Nothing) Then
wsCustomers.Close
Set wsCustomers = Nothing
End If

If Not (dbEngine Is Nothing) Then
Set dbEngine = Nothing
End If
End If

End Sub
Private Sub Workbook_Open()

Dim lngTotal_RAM As Long
Dim vntMax_Buffer_Size As Variant

blnDatabase_Open = False
Set dbEngine = Nothing
Set dbCustomers = Nothing
Set wsCustomers = Nothing

' *** HKEY_CLASSES_ROOT\DAO.DBEngine.35\CLSID <==> c:\Program Files\Common Files\Microsoft Shared\DAO\DAO0350.DLL
' *** HKEY_CLASSES_ROOT\DAO.DBEngine.36\CLSID <==> c:\Program Files\Common Files\Microsoft Shared\DAO\DAO0360.DLL

Set dbEngine = CreateObject("DAO.DBEngine.36")

dbEngine.SystemDB = strWorkgroup_System_Filename

Set wsCustomers = dbEngine.CreateWorkspace("", strDatabase_User_Name, strDatabase_User_Password)

Set dbCustomers = wsCustomers.OpenDatabase(strDatabase_Filename, False, False)

If Err.Number = 0& Then
lngTotal_RAM = CLng(dblTotal_Physical_Memory() * 1024&)
vntMax_Buffer_Size = CVar(((lngTotal_RAM - (12& * 1024&)) / 4) + 512)

dbEngine.SetOption lngDAO_dbMaxBufferSize, vntMax_Buffer_Size

blnDatabase_Open = True

frmScanning.Show
End If

End Sub
Private Function dblTotal_Physical_Memory() As Double

Dim dblReturn As Double
Dim udtMEMORY_STATUS As udtMEMORY_STATUS

On Error Resume Next

dblReturn = 0

Call GlobalMemoryStatus(udtMEMORY_STATUS)

dblReturn = udtMEMORY_STATUS.lngTotal_Physical

dblTotal_Physical_Memory = dblBytes_To_Megabytes(dblReturn)

End Function
Private Function dblBytes_To_Megabytes(ByVal dblBytes As Double) As Double

On Error Resume Next

dblBytes_To_Megabytes = CDbl((dblBytes / 1024) / 1024)

End Function

' ...End of code

Now, add a global (public) code module, and add this code:

' Start of code...

Option Explicit
' ----------------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Applications \ MS Office \ Excel
' https://www.experts-exchange.com/questions/21595178/Can-an-Access-Form-be-opened-and-used-within-Excel.html
' Can an Access Form be opened and used within Excel
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 4 October 2005 to 16 October 2005
' ----------------------------------------------------------------------------------
' See also...
' https://www.experts-exchange.com/questions/21582596/Setting-VB-code-to-listen-on-com-port-for-input.html
' Setting VB code to listen on com port for input
' ----------------------------------------------------------------------------------
' and...
' https://www.experts-exchange.com/questions/21595092/Capturing-a-data-string-from-Serial-Port-COM1-requires-scanning-the-card-2-times.html
' Capturing a data string from Serial Port (COM1) requires scanning the card 2 times
' ----------------------------------------------------------------------------------

Public blnDatabase_Open As Boolean
Public dbEngine As Object
Public dbCustomers As Object ' DAO.Database
Public wsCustomers As Object ' DAO.Workspace

Public Const lngDAO_dbMaxBufferSize As Long = 8&
Public Const lngDAO_dbRefreshCache As Long = 8&
Public Const strDatabase_Filename As String = "c:\customers.mdb" ' *******
Public Const strDatabase_User_Name As String = "admin"
Public Const strDatabase_User_Password As String = ""
Public Const strWorkgroup_System_Filename As String = "c:\windows\system32\system.mdw"

' ...End of code

Note the line:
Public Const strDatabase_Filename As String = "c:\customers.mdb" ' *******

Change the "c:\customers.mdb" value to the path of your database file that contains the [TEMPORARY] table.

Finally, save the workbook. Close it. Then re-open.

Click the [Start Scanning] button as before.

BFN,

fp.