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 gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

3904 change script

Status
Not open for further replies.

theshark44

Technical User
May 19, 2005
2
US
hello

does anyone have a script for changing 3904s i have built all the sets now i need to add numbers to the 3904s on 2 kba mods and i have 150 of these to do i use reflections for the programming

thanks

 
i went to the forum and really nothing on reflections the on ei hhave to change 3904 sets works other than i get this
message

sch6711 on key 32 and i have tried everything in the script to stop this i have 150 sets to change and it wont let me with this error here is what the script looks like if anyone can look at and suggest a change will try that

'TN In column C4
'Changes from E, F, G onwards

Sub Main
Const NEVER_TIME_OUT = 0


Dim LF$ ' Chr$(rcLF) = Chr$(10) = Control-J,
Dim CR As String ' Chr$(rcCR) = Chr$(13) = Control-M
Dim ExcelA as Object, I%, TN$, File_Loc$, VAL$, J%, CHAR$, Will$, Num$, CHAR1$, CHAR2$

Set ExcelA = CreateObject ("Excel.Application")

With ExcelA
.Caption="Excel - CHG Program - Will Barratt ©"

.Visible=True

If command="" Then .Workbooks.Open "C:\Documents and Settings\ron sweat\My Documents\complete\convert69"
If command<>"" Then .Workbooks.Open Command
.Worksheets(1).Activate
End With



LF = Chr$(rcLF)
CR = Chr$(rcCR)
I = 4
J = 5
TN=ExcelA.Cells(I,3)
VAL=ExcelA.Cells(I,J)

With Application
.Transmit "****" & CR
.WaitForString ">", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit "ld 20" & CR

Do until len(TN)<8
.WaitForString "REQ: ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit "chg" & CR
.WaitForString "TYPE: ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit "3904" & CR
.WaitForString "TN ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit TN & CR
.WaitForString "ECHG ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit "yes" & CR
.WaitForString "ITEM ", NEVER_TIME_OUT, rcAllowKeystrokes
Do until Val=""


.wait 0.1
.Transmit Val & CR

If Left(val,3)="key" or Left(val,3)="KEY" or left(val,4)=" key" or left(val,4)=" KEY" or left(val,4)="KEY " or left(val,4)="key " or left(val,4)="Key " then
.wait 0.5
.TRANSMIT CR

CHAR=.ReadChars(2,0)


If left(CHAR,1)<>LF then

.WaitForString LF, NEVER_TIME_OUT, rcAllowKeystrokes
CHAR=Application.ReadChars(4,0)
ExcelA.Cells(1,1)=Char

If Char<>"ITEM" then
char=Application.ReadChars(7,0)
ExcelA.Cells(1,1)=Char

If Right(CHAR,4)= "VMB " then
.Transmit CR
.waitForString "KEY ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit CR
End If
If Right(CHAR,4)= "CPND" then
.Transmit CR
.waitForString "VMB ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit CR
.waitForString "KEY ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit CR
end if
If Right(CHAR,4)= "MARP" then
.Transmit CR
.waitForString "CPND ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit CR
.waitForString "VMB ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit CR
.waitForString "KEY ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit CR
end if
end if
End if
If Left(CHAR,3)<>"SCH" Then
ExcelA.Cells(I,J).Interior.ColorIndex = 4
else
ExcelA.Cells(I,J).Interior.ColorIndex = 3
end if

end if
If Left(CHAR,3)<>"SCH" Then
ExcelA.Cells(I,J).Interior.ColorIndex = 4
else
ExcelA.Cells(I,J).Interior.ColorIndex = 3
end if

CHAR=""
J=J+1
Will=""
Val= ExcelA.Cells(I,J)

Loop

.wait 0.5
.Transmit CR
.Transmit CR

I=I+1
J=5
TN=ExcelA.Cells(I,3)
Val=ExcelA.Cells(I,J)
CHAR=""


loop
.WaitForString "REQ: ", NEVER_TIME_OUT, rcAllowKeystrokes
.Transmit "****" & CR


End With
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top