Using Attachmate, I am trying to write a VBA script that reacts when a specific phrase occurs and automatically executes commands via inline commands. Essentially, when a phrase appears, an inputbox appears asking the user for a specific quantity and the VBA code takes that quantity, inserts it into the terminal and then jumps around different menus to create an internal label. However, my problem is that I don't know how to have the VBA code react to the different strings that may be returned by the host. Sometimes it says "enter to continue" and sometimes it says "select user". So what I want it to do is based on the statement it receives to do a certain action, but I don't know what the command is for capturing what the terminal is receiving from the host. I've tried "waitforstring" and "readline" but it is obvious I am not using them correctly. Below is the code I have built thus far, please be gentle as it is still very unfinished. I have commented out several parts of it in attempts to troubleshoot my problems:
'variable declarations
Dim count As Long 'var used to indicate how many times code should loop (how many labels should be print)
Dim drugname As String
Dim qtyinput As Long
Dim CR As String ' Chr(rcCR) = Chr(13) = Control-M
Dim LF As String ' Chr(rcLF) = Chr(10) = Control-J
Dim strcheck As String
'assign values to variables
count = 0
CR = Chr(Reflection2.ControlCodes.rcCR)
LF = Chr(Reflection2.ControlCodes.rcLF)
qtyinput = InputBox("Number of items being sent", Quantity)
drugname = .GetText(22, 15, 22, 46) ' StartRow:=22, StartColumn:=15,EndRow:=22, EndColumn:=46 'copies text from screen
' Press EditCopy (Copy the selection and put it on the Clipboard).
'.Copy rcSelection, rcAsPlainText -- not needed
.Transmit qtyinput & CR
.Transmit CR
'strcheck = .readline("00:00:01")
'MsgBox strcheck
'If .WaitForString("Press " & Chr(34) & "RETURN" & Chr(34) & " to continue, " & Chr(34) & "^" & Chr(34) & " to stop: ") Then .Transmit CR
'Select Case strcheck
' Case strcheck Like "to continue"
' .Transmit CR
'Case strcheck Like "*Select CLIENT*"
' .Transmit CR
'End Select
.Transmit "^MED" & CR
.Transmit "3" & CR
.Transmit "10" & CR
First of all, Attachmate is the company, and they have a few products for accessing Mainframe sessions from Windows including EXTRA! and Reflections, both of which share a common scripting language, which is nice and easy to use from within VBA.
However, EXTRA! tends to have fewer commands available to use than Reflections, which is the more expensive product, so you have to get a little creative with your VBA.
I think you are using EXTRA!, so the command you are looking for is "GetString"
I use VBA to interact with a mainframe session in EXTRA!, and I know that my mainframe command is successful when three stars appear on the screen in a certain position.
The mainframe command can take anywhere between 1 second and 5 minutes to complete, so I use "GetString" to poll the mainframe session every second, waiting for the three stars before I continue:
Do Until Sess0.Screen.GetString(14, 2, 3) = "***"
Application.Wait (Now + TimeValue("0:00:01"))
Loop
The syntax for "GetString" is: GetString(Row, Column, Length)
In my case the stars appear at row 14, column 2, and I know there will always be 3 of them, so I set my string length to 3.
Related
I've created a form that works well with macros running in the background to validate data and then print the document to a specific printer on the network.
The key element of this process is a production number value which I would like to keep a running log of and display in a static status dialog window. In other words, a popup window similar to a MsgBox that would not interfere with other actions on the form, but float on top of the document.
Visual concept of this would be...
User could shift the window away from their work if needed. Close the window if they desired, but pragmatically I want to re-pop/refresh the data in the window each time the background macro completes.
I can't use MsgBox, because it forces a closure of the window before the user can continue working on the document. I just want this visible to the user so they know what was last worked on and the few prior to that.
Any idea what control I might be able to use, or switch to MsgBox that would allow the user to continue working?
Ken...
PS: I found this and am trying to find a way to make this work for me. So far I have managed to get to function in the manner I want, but the lingering issue is how to call this PS script and include the information I need to display.
Alternatives to MsgBox in VBScript - StackOverflow
PPS: I opted to go a slightly different route and release the form with a MsgBox that is displayed at the end of the macro. I describe this in the solution noted below.
Instead of using a MsgBox, please consider using a VBA Userform. They're not much more complicated to use than a MegBox, but you can set them to be Modeless. Modeless dialogs remain open on-screen while you work on the Word document. Here'is Microsoft's page on setting dialogs as Modal or Modeless: Show method
If you search on VBA modeless dialog, you'll find many other helpful pages on the subject.
After doing much research, I've come back to revising my macro to incorporate static variables and a MsgBox at the end to report the last 5 production numbers that have been printed.
To provide a means of bringing up this MsgBox for reference, between printing runs, I created an OnlyNum variable as string and replaced the MsgBox I had for letting the users know they were only to use numbers in this field with that message. The end of that trap diverted the flow to the bottom of the macro (where the MsgBox that displayed the last five print jobs has been placed).
So, when the status MsgBox is displayed as a result of printing it only shows the last five events. If the trap captures it, it shows the message letting the user know to only use numerals and then displays the last five events.
Code reference:
Private Sub CommandButton1_Click()
Dim Prod As String
Dim Temp As String
Dim OnlyNum As String
Static ProdNum1 As String
Static ProdNum2 As String
Static ProdNum3 As String
Static ProdNum4 As String
Static ProdNum5 As String
'Check for only numeric value of TextBox1.Text
If Not IsNumeric(TextBox1.Value) Then
OnlyNum = "only numbers allowed" & vbCrLf & vbCrLf
Cancel = True
GoTo NotToday
End If
'Remove any spaces from TextBox1.Text
Prod = Replace(TextBox1.Text, " ", "")
'If the resulting lenght is equal to 7 Print it.
If Len(Prod) = 7 Then
ActiveDocument.PrintOut
'Update recent production numbers (5 in total)
ProdNum5 = ProdNum4
ProdNum4 = ProdNum3
ProdNum3 = ProdNum2
ProdNum2 = ProdNum1
ProdNum1 = Prod & " - " & Now() ' Insert a new production number with timestamp
TextBox1.Text = "" 'Clear the value of TextBox1.Text to prepare for the next Production number
Else
MsgBox ("Production Numbers must be 7 digits and contain only numerials.")
End If
NotToday:
Application.ActivePrinter = Temp
MsgBox (OnlyNum & ProdNum1 & vbCrLf & ProdNum2 & vbCrLf & ProdNum3 & vbCrLf & ProdNum4 & vbCrLf & ProdNum5)
OnlyNum = "" 'Reset value of OnlyNum
End Sub
I have the following VBA which updates the command text in my data connection in excel.
Sub ClaimLine_Macro()
Dim strsql As String
strsql = "Select a.* from claim a "
strsql = strsql & Worksheets("SQL_ClaimLine").Range("claim1")
strsql = strsql & Worksheets("SQL_ClaimLine").Range("claim2")
strsql = strsql & Worksheets("SQL_ClaimLine").Range("claim3")
With ActiveWorkbook.Connections("ClaimLineExtract").ODBCConnection
.BackgroundQuery = True
.CommandText = strsql
End With
ActiveWorkbook.Connections("ClaimLineExtract").Refresh
End Sub
If I run the VBA above I get the error Run-time error 1004 application-defined or object defined error.
What's interesting is if I comment out
strsql = strsql & Worksheets("SQL_ClaimLine").Range("claim3")
The VBA works! I am not sure what is causing the error.
Further more, if I run the VBA without claim3 and copy and paste the SQL in to TOAD, I get one really long text string.
When I run it with claim3, it now wraps the text string at character 1,023 on every line. I believe this is causing the issue. Is there any way around the wrapping at 1,023 characters?
The ranges in the VBA (Claim1, claim2, and claim3) each reference a single cell that contains a concatenated block of 1,000 claims. The cells have a UDF formula that places them into the correct syntax while appending "or a.claim " at the end when needed. Claim1 is hardcoded to say "Where a.claim " in the beginning.
I have been trouble shooting to see if it is a specific claim but what I found is a little weird. Each range has 1,000 claims in it, regardless of which range I change, if I reduce the total number of claims to 2,580 the VBA will work with no error(If I increase to 2,581 the VBA errors). This means there are 32,698 characters in the strSQL.
I was able to find a solution! The issue was with the length of the character strings and how the VBA was reading/splitting the lines. After hours of researching, looking for similar issues, I came across a solution. I had to create a function that broke the VBA into smaller chunks.
The VBA below is a function that allows the VBA string to max out at 200 characters.
Function SplitMeUp(strin As String)
Const MAX_LEN As Long = 200
Dim rv(), n, i
n = Application.Ceiling(Len(strin) / MAX_LEN, 1)
ReDim rv(0 To n - 1)
For i = 1 To n
rv(i - 1) = Mid(strin, 1 + ((i - 1) * MAX_LEN), MAX_LEN)
Next i
SplitMeUp = rv
End Function
This means in my the line for my command text now looks like this.
.CommandText = SplitMeUp(strsql)
By splitting up the strsql, and then having it put back together allows the SL to be read correctly in the data connections and does not result in a runtime error.
As a bonus I went out to a range of claim23 (so that's 23,000 claims) and the VBA still worked!
I tried to write a code block which displays all of the pre-declared processes in a MessageBox:
Dim pro As String = "chrome" & "firefox"
Dim prox() As Process
Try
prox = Process.GetProcesses()
For Each process As Process In prox
If (pro = process.ProcessName) Then
MsgBox("Process Found: " & pro & " ,")
End If
Next process
But whenever I try to match from a list with more than one program, it fails to match any of them. How can I rewrite the code so it can match from a list of processes?
In a generic way, and looking into future maintaining and ease of reading you could use this:
'use ; as separator, keep one at the beginning and one at the end
Dim pro As String = ";chrome;firefox;iexplorer;safari;etc;"
Then instead of doing a straight equality test if pro = processname do
If (pro.Contains(";" & process.ProcessName & ";") Then
To read you only need to look at two lines (instead of several for an array based solution).
To maintain (add/remove from the list), just update the first line.
I am building a quite complex UserForm that uses ADO connection to connect to another Excel workbook that serves as a database and retrieve & insert data via SQL queries. Please note I am not allowed to use Access in this case.
I have already figured out how to use SELECT, but there is one particular error with INSERT I can't resolve. That bothers me a lot, I've put a lot of work to it.
First the connection (I use JET for retrieving data and ACE for saving data as I was not able to get JET to work for that):
Public Sub InsertDataToSheet(SQLCmd As String)
Dim cnx As Object
Set cnx = CreateObject("ADODB.Connection")
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source='" & ThisWorkbook.Path & "\Database.xls'; Extended Properties=Excel 12.0;"
cnx.Execute SQLCmd
cnx.Close
End Sub
Then there is a subroutine linked to a Submit button that actually generates the Query as I need to save only filled out Textboxes and Combos to avoid Nulls:
Private Sub SaveRecord()
Dim SQL As String
SQL = "INSERT INTO [Report$A2:AM50000] ("
Dim i As Control
For Each i In Me.controls
If TypeName(i) = "TextBox" Or TypeName(i) = "ComboBox" Then
If i <> e Then SQL = SQL & i.Name & ","
End If
Next i
SQL = Mid(SQL, 1, Len(SQL) - 1) & ") VALUES(" ' Remove last space & comma
Dim j As Control
For Each j In Me.controls
If TypeName(j) = "TextBox" Or TypeName(j) = "ComboBox" Then
If j <> e Then
If j = "Unknown" Then MsgBox "Fire"
Select Case IsNumeric(j)
Case False
SQL = SQL & "'" & j & "'" ' Add single quotes around strings
Case True
SQL = SQL & j
End Select
SQL = SQL & ","
End If
End If
Next j
SQL = Mid(SQL, 1, Len(SQL) - 1) & ")" ' Remove last comma
' Connect
InsertDataToSheet (SQL)
End Sub
There are two particular textboxes in the form that work exactly the same. Normally, users enter numbers to them and everything saves fine (don't mind the '+' buttons):
Sometimes, however, users do not know the values but can't leave those empty. That's when they are supposed to tick the checkboxes to set the value(s) to 'Unknown':
Now there comes the funny part – for the Batch field, it saves fine. But when I set the Shipment ID to 'Unknown' (or any other string), it throws an error:
Note the fields are not Disabled, just Locked with some appearance changes. I was also unable to find any specific details about the error, but it seems there is some problem with the query:
(It says something like 'Incompatible data types in the expression'). The generated query is this:
Any ideas what goes wrong? I'd very much like to keep the functionality as it is know and solve the error rather than redesign it as it already took some effort and the fields can't stay empty.
Never used sql in xls workbooks, but I had this problem with SQL server already. There's nothing "wrong" with your query, the problem is that data type that's accepted on the field of the table you want to insert. Try to turn that field to use text values instead of numbers and it should work.
I have scoured the net for days trying to figure this out, but apparently my gaps in Access are too severe and the answer eludes me. Someone has apparently already answered this question, however I'm not able utilize the information.
My specific situation:
Table1 has 30,000+ rows and multiple columns. "Photo Path" is a text field with the path and filename of an image. "Photo" is an OLE Object field currently empty.
What I would like to do is store the image specified in "Photo Path" as an OLE object in "Photo".
Table1 Current State:
Name - Photo Path - Photo
Impala - C:\Cars\Impala.jpg -
Jeep - C:\Cars\Jeep.jpg -
Table1 Desired Result:
Name - Photo Path - Photo
Impala - C:\Cars\Impala.jpg - LONG BINARY DATA
Jeep - C:\Cars\Jeep.jpg - LONG BINARY DATA
I don't know how to execute FileToBlob() against my entire database using the generously provided code. The authors seem to expect me to use a form, which I was unable to get to work as well.
What I think I want is an SQL statement that will execute against every row in Table1 using FileToBlob() or something close to it.
I've tried variations of the following statement in the SQL Query to no avail.
SELECT Table1.[Photo Path], FileToBlob(Table1.[Photo Path],Table1.Photo) As Photo
FROM Table1;
Thank you for taking the time to read this and providing an answer.
Had to figure this one out for myself as there were no responses. For those may follow looking for an actual answer, here it is.
I modified the code that that I found to fit my specific problem.
Create a new module and put the code below in it. If by chance the code does not work, you can try going to Tools-->References and if not already selected, select "Microsoft DAO X.x Object Library" where X.x is the latest library. If it still doesn't run you'll have to check to see if you need to select any other references.
There are so many records to go through, I felt better doing this through code instead of a query that may take a long time to execute and one won't know what is going on. In the code I have it writing to the status bar in Access so you know where you are at (but if the files are small it will probably fly by, but at least you know it is working).
To run the code, just put your cursor anywhere in the routine and I first like to press F8 which steps into the code just to make sure I'm in the right routine. Then press F5 to run the rest of the code. If you want to create a form to run the code instead you can do that too. Just create a button and on the "on click" event add the code:
call Load_Photo()
If you want to see the status updates, make sure the main access window is visible before you run the code (If you run from a form, it will already be there).
Note I renamed the field "Name" in Table1 to "strName" because "Name" is a reserved word. I'd suggest not using "Name" as a field name. You might be OK, but you could run into issues at some point, especially when referencing the field through code. If you choose not to change the field name, change the code.
Also note that the sample code provided stored as a binary. So if you create an Access form to show the records, the image will not automatically appear - there is some other manipulation necessary that I am not familiar with off hand.
Without further ado, here's the code to solution I was looking for:
Option Compare Database
Option Explicit
Public Sub Load_Photo()
On Error GoTo LoadFileError
Dim strSQL As String
Dim rstTable As DAO.Recordset
Dim strStatus As String
Dim count As Integer
Dim strFile As String
Dim nFileNum As Integer
Dim byteData() As Byte
Dim varStatus As Boolean
'
' In case something happens part way through the load, just load photos that have not been loaded yet.
'
strSQL = "Select [strName], [Photo Path], [Photo] from Table1 Where [Photo] is null"
Set rstTable = CurrentDb.OpenRecordset(strSQL)
If rstTable.RecordCount > 0 Then
rstTable.MoveFirst
count = 0
Do While Not rstTable.EOF
strFile = rstTable![Photo Path]
If Len(Dir(strFile)) > 0 Then
nFileNum = FreeFile()
Open strFile For Binary Access Read As nFileNum
If LOF(nFileNum) > 0 Then
count = count + 1
'
' Show user status of loading
'
strStatus = "Loading photo " & count & " for " & rstTable![strName] & ": " & rstTable![Photo Path]
varStatus = SysCmd(acSysCmdSetStatus, strStatus)
DoEvents
ReDim byteData(1 To LOF(nFileNum))
Get #nFileNum, , byteData
rstTable.Edit
rstTable![Photo] = byteData
rstTable.Update
Else
MsgBox ("Error: empty file, can't load for Name = " & rstTable![strName] & " and Photo Path = " & rstTable![Photo Path])
End If
Close nFileNum
Else
MsgBox ("Error: File not found for Name = " & rstTable![strName] & " and Photo Path = " & rstTable![Photo Path])
End If
rstTable.MoveNext
Loop
End If
LoadFileExit:
If nFileNum > 0 Then Close nFileNum
rstTable.Close
strStatus = " "
varStatus = SysCmd(acSysCmdSetStatus, strStatus)
Exit Sub
LoadFileError:
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error on " & strFile
Resume LoadFileExit
End Sub