Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Screen Scrape to Access Table

Status
Not open for further replies.

trickshot1126

Technical User
Feb 5, 2015
26
US
Hello,

Thank you for all the knowledge on this site... It is beyond helpful.

I have a good understanding of Excel VBA coding but am trying to move some things over to Access for historical reporting purposes. Currently in excel i have coding that scrapes from attachmate and pastes to cells in excel.

What i am trying to do is scrape the same info but rather than going to excel cells place the date into a data table in Access.

The following is my excel scripting:

Private Sub Cancelform()
Dim extra As Object
Dim PMS As Object
Dim sInput As String, Agent As String, Name As String, Adress1 As String, Adress2 As String
Dim iWait As Integer, I As Integer, finalRow As Integer, fail As Integer
Dim polNums As String, Cell As String, Zip As String, Effdate As String, Expdate As String, Homeprem As String, Autoprem As String, acode As String


'Verify that the user chose the right macro


iWait = MsgBox("Please be patient and do not touch PMS or Excel after hitting OK.", vbOKCancel)
If iWait = 2 Then
MsgBox (" Process Cancelled!")
Exit Sub
End If

iWait = 30 'milliseconds to wait for server to stop sending data

'Identify the last cell that contains a policy number
finalRow = ActiveSheet.Range("A65536").End(xlUp).Row
finalcolumn = Range("IV1").End(xlToLeft).Column
Range("A2:A" & finalRow).Select

Set polNums = Selection
Set extra = CreateObject("Extra.System")
Set PMS = extra.activesession.screen



'Set our number of failed policies equal to zero
I = 0

'Grab the info
For Each Cell In polNums

'If the policy number starts with a zero, the system will remove the leading zeros.
'Thus we "recast" the value to a string and ensure the policy number is seven
'characters long. It would only ever be shorter because it missed leading zeros.

If Cell = "" Then GoTo NextPolicy
If Cell.Offset(, 10).Value = "Pass" Then GoTo NextPolicy

sInput = Cell.Value
Do While Len(sInput) < 7
sInput = "0" & sInput
Loop

PMS.SendKeys ("<Clear>EINQ " & sInput & "<Enter>")
Do Until PMS.getstring(3, 2, 1) = "S" Or PMS.getstring(1, 69, 3) = "NOT" Or PMS.getstring(1, 63, 7) = "INVALID"
PMS.waithostquiet (iWait)
Loop

'If there is an entry pending on the EINQ screen, we will skip this policy
'If our policy number is invalid, add the word "Fail" in the color red to our results page

If PMS.getstring(1, 63, 7) = "INVALID" Then
Cell.Offset(, 11).Value = "Invalid Policy Number"
GoTo fail
End If


'**************************************************************************
'Go to PBBC Screen to get Insured Name, address, and dates
PMS.SendKeys ("<Clear>PBBC " & sInput & "<Enter>")
Do Until PMS.getstring(3, 2, 3) = "UND"
PMS.waithostquiet (iWait * 10)
Loop
Name = PMS.getstring(5, 10, 29)
Cell.Offset(, 1).Value = Name
Adress1 = PMS.getstring(6, 10, 29)
Cell.Offset(, 2).Value = Adress1
Adress2 = PMS.getstring(6, 41, 29)
Cell.Offset(, 3).Value = Adress2
Zip = PMS.getstring(6, 74, 5)
Cell.Offset(, 4).Value = Zip
Effdate = PMS.getstring(9, 14, 6)
Cell.Offset(, 5).Value = Effdate
Expdate = PMS.getstring(9, 34, 6)
Cell.Offset(, 6).Value = Expdate
acode = PMS.getstring(8, 33, 7)
Cell.Offset(, 8).Value = acode


'Go to PBOI Screen to get Agent
PMS.SendKeys ("<Clear>PBOI " & sInput & "<Enter>")
Do Until PMS.getstring(3, 2, 3) = "LOB"
PMS.waithostquiet (iWait * 10)
Loop
Agent = PMS.getstring(3, 48, 30)
Cell.Offset(, 7).Value = Agent


'Go to PBPR Screen to get Premium
PMS.SendKeys ("<Clear>PBPR " & sInput & "<Enter>")
PMS.waithostquiet (iWait * 10)
If PMS.getstring(1, 7, 1) = "A" Then
Autoprem = PMS.getstring(2, 24, 10)
Cell.Offset(, 10).Value = Autoprem
GoTo Pass
End If
Homeprem = PMS.getstring(16, 39, 12)
Cell.Offset(, 9).Value = Homeprem


Pass:
'Add the word "Pass" in the color green to our results if the PUUC is successful
Cell.Offset(, 11).Value = "Pass"
Cell.Offset(, 11).Interior.ColorIndex = 4
GoTo NextPolicy

fail:
'Add the word "Fail" in the color red to our results if we cannot change tier
Cell.Offset(, 11).Value = "Fail"
Cell.Offset(, 11).Interior.ColorIndex = 3
fail = fail + 1




'Move on to the next policy
NextPolicy:
Cell.Offset(1, 0).Activate
Next Cell


Range(Cells(1, 1), Cells(finalRow, 5)).Borders.Weight = xlThin
ActiveSheet.Range("A2").Activate
ActiveWindow.FreezePanes = True

If fail > 0 Then
MsgBox "There were a total of " & fail & " policie(s) that failed during processing. Use the filter to identify these failures."
Else
MsgBox "Process 100% Successful."
End If

Exit Sub


As you can see it travels through different screens, collects the data and pastes it to excel.

Any help would be awesome.

Thank you,
Rob
 
But on a more substantial matter, you do understand that your terminal emulator interfaces with a system (usually a mainframe) that processes the data entered on the screen ASYNCHRONOUSLY, that is the mainframe's response might be 1 millisecond, 1 second, 1 minute...who knows???

I like to think of it like driving up to an intersection. Would you predetermine that you'll wait 10 seconds at each intersection and then go, regardless of the ASYNCHRONOUS traffic conditions? I wouldn't! You WAIT UNTIL you have feedback that indicates that it is safe to proceed through the intersection.

In terms of your screen, when you SendKeys, the mainframe goes off, processes the request and returns data to a screen, Causing the cursor to rest a predefined coordinates. You ought to Loop Until WaitForCursor(row, col) is TRUE.
 
Hi SkipVought,

Thanks for the thought on the timing... I will have to update this, i hadn't thought of it like that...

If i left it in excel and imported the data would excel need to be open? Or can the macro be run from access and be done in the background? Is there no way to do it in Access or just more of a paid to adjust the code for access?

Thanks for the help!

ROb
 
So is this a recurring process? I'd guess, yes.

Then you would be doing, what, an append query with the Excel table as the data source? You could call an Access macro to perform this, yes?

 
@TrickShot, you could just save & close the Excel file after it's been populated and then set up a macro or code to pull it in from your Access db. You can have the entire process run from Access but you'd have to change quite a few things. If you're more comfortable working with Excel & Excel VBA, then my first suggestion. ;)
 
Thanks for the responses. Doing it all through Access would be my preference. This is going to be loaded on about 100 machines and used daily. I'd prefer to keep it all within one document.

 
Loaded on about 100 machines..."

Don't you have ONE MS Access database? Why on 100+ machines???
 
Just thinking about the 100+ machines, you might ought to think about a backend DB and 100+ front ends to access the db.
 
Hi again,

Yes i currently have one access database but once completed it will be loaded onto a shared drive that will be used by about 100 users. I also had the thought of loading it onto all the machines and linking them to the backend database to keep the info safe but all of that will come once it is built out. I still am at a stand still with scraping the data from the mainframe.

Again, the above code is used in excel to get the needed data. Anyhelp on how it can be changed and used in Access? The info will be loaded into one table call it "tblMainframe" and will go into the table based on the same info the excel code was putting data into cells.

Thank you,
Rob
 
Hi Rob, it would take too long to explain in writing in a forum. If you want contact me via jdowski AT gmail dotcom
 
Thank your for all who helped! With some time and A LOT of patience i was able to get this working.

If only it could move as fast as the VBA code would... First world problem i guess. [lol]

 
Hey guys,

I've occasionally done an offline consultation, but ALWAYS close the question out with full disclosure of the solution for the benefit of other members.

That's what Tek-Tips is all about. It's not just getting a solution.
 
Hi Skip,

Thanks for the note. I'll keep that in mind.

The VBA difference between excel and access are just enough to be frustrating.

BTW...
The solution was as simple as completely removing all the excel specific coding and replacing it with what access needs. Pretty basic stuff really but a bit overwhelming given the length of code.

Keeping in mind full disclosure the following is the coding that allowed me to interact with my attachmate session and screen scrape what was needed.

Sub PMS_Info()

Dim EXTRA As Object, PMS As Object, MyScn As Object, polnums As Object
Dim sInput As String, Agent As String, Name1 As String, Name2 As String, Address1 As String, Address2 As String
Dim iWait As Integer, i As Integer, finalrow As Integer, fail As Integer
Dim Zip As String
Dim EffDate As String
Dim ExpDate As String
Dim Autoprem As String
Dim Homeprem As String
Dim aCode As String
Dim db As Database
Dim rstPMSInfo As DAO.Recordset
Dim rstPMSAuto As DAO.Recordset
Dim rstPMSHome As DAO.Recordset
Dim rsPMSAgtInfo As DAO.Recordset
Dim rstPMSAgtInfo As DAO.Recordset
Dim dbCSCGenerator As DAO.Database
Dim NextScreen As Variant

iWait = MsgBox("Please be patient and do not touch PMS or Excel after hitting OK.", vbOKCancel)
If iWait = 2 Then
MsgBox ("Cancelled!")
Exit Sub
End If

iWait = 30

Set EXTRA = CreateObject("Extra.System")
Set PMS = EXTRA.activesession.Screen
Set dbCSCGenerator = CurrentDb
Set rstPMSInfo = dbCSCGenerator.OpenRecordset("tblPMSInfo")

sInput = DLast("[PolNum]", "tblpolnum")

PMS.SendKeys ("<Clear>EINQ " & sInput & "<Enter>")
Do Until PMS.getstring(3, 2, 1) = "S" Or PMS.getstring(1, 69, 3) = "NOT" Or PMS.getstring(1, 63, 7) = "INVALID"
PMS.WaitHostQuiet (iWait)
Loop

PMS.SendKeys ("<Clear>PBBC " & sInput & "<Enter>")
Do Until PMS.getstring(3, 2, 3) = "UND"
PMS.WaitHostQuiet (iWait * 10)
Loop
rstPMSInfo.AddNew
PolicyNum = sInput
rstPMSInfo("PolicyNums").Value = PolicyNum
Name1 = Trim(PMS.getstring(5, 10, 29))
rstPMSInfo("NI1").Value = Name1
Name2 = Trim(PMS.getstring(5, 41, 29))
rstPMSInfo("NI2").Value = Name2
Adress1 = Trim(PMS.getstring(6, 10, 29))
rstPMSInfo("Address1").Value = Adress1
Adress2 = Trim(PMS.getstring(6, 41, 29))
rstPMSInfo("Address2").Value = Adress2
Zip = PMS.getstring(6, 74, 5)
rstPMSInfo("Zip").Value = Zip
EffDate = Trim(PMS.getstring(9, 14, 6))
rstPMSInfo("effDate").Value = EffDate
ExpDate = Trim(PMS.getstring(9, 34, 6))
rstPMSInfo("expDate").Value = ExpDate
aCode = Trim(PMS.getstring(8, 33, 7))
rstPMSInfo("AgentCode").Value = aCode

rstPMSInfo.Update

Set EXTRA = Nothing
Set PMS = Nothing
Set dbCSCGenerator = Nothing
Set rstPMSInfo = Nothing

End Sub

Hope this helps someone else find what they are looking for.

Rob
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top