不使用 excel 和 IBM 3270 终端结束

Question

我正在研究一个宏来提取收据数据，我只需要找到今天收据的数量。使用 IBM 终端，我调出一个 excel 工作表，然后继续使 IBM 转到我需要的屏幕，然后查看屏幕上的日期并将其与接收日期匹配。如果今天的日期与第一页上的接收日期不匹配，那么我需要让宏按 Enter 键，然后在第二页搜索匹配日期，依此类推，直到日期匹配，或者如果它们永远不会停止接收日期为空。我的代码如下。不确定打开函数在哪里不让代码完成。我是新手，不知道格式化代码，我提前道歉。

感谢您提供的任何帮助。

Sub RMBR()
Dim infile As String
Dim part As String * 19, COMMENT As String * 7, COMMENT2 As String * 2
Dim TDATE As String * 7, PLANT As String * 1
Dim source As String
Dim SELECTION As Integer, i As Integer, c As String
Dim Result As Single
Dim excel As Object
Dim ACELL As Single, BCELL As Single, CCELL As Single, dcell As Single
Dim Verify As Single
infile = InputBox$("input FILE NAME INCLUDING PATH?", "FILE NAME", "C:CFILESrmbr.XLSX")
TDATE = InputBox$("Input Status", "TDATE", "CURRENT")

i = 2
Set excel = CreateObject("EXCEL.APPLICATION")
excel.Visible = True
excel.Workbooks.Open FileName:=infile
Verify = MsgBox("IS THIS THE CORRECT SPREADSHEET?", 4, "VERIFY SPREADSHEET")
ACELL = "A2"
BCELL = "B2"
CCELL = "C2"
DCELL = "D2"

excel.Range("A1").Select
excel.activecell.FormulaR1C1 = "PARTNO"
excel.Range("B1").Select
excel.activecell.FormulaR1C1 = "RMBR QTY"
excel.Range("C1").Select
excel.activecell.FormulaR1C1 = " "
excel.Range("D1").Select
excel.activecell.FormulaR1C1 = "TODAY'S DATE"
excel.Range(ACELL).Select
part = excel.activecell.FormulaR1C1
excel.Range(BCELL).Select
PLANT = excel.activecell.FormulaR1C1
excel.Range(CCELL).Select
COMMENT = excel.activecell.FormulaR1C1
excel.Range(dcell).Select
COMMENT2 = excel.activecell.FormulaR1C1

Do Until partnumber = "                "
With Session
.TransmitTerminalKey rcIBMClearKey
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1
.WaitForEvent rcEnterPos, "30", "0", 1, 1
.TransmitANSI "RMBR"
.TransmitTerminalKey rcIBMEnterKey
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1
'.WaitForEvent rcEnterPos, "30", "0", 2, 6
.WaitForDisplayString "FN:", "30", 2, 2
.MoveCursor 4, 11
.TransmitANSI part
.TransmitTerminalKey rcIBMEnterKey
.WaitForEvent rcKbdEnabled, "30", "0", 1, 1
Date = .GetDisplayText(4, 73, 8)
RIP.Date = .GetDisplayText(9, 73, 8)

Dim n As Integer
For n = 9 To 22
Do Until Date = RIP.Date
Date = .GetDisplayText(9, 73, 8)
RIP.Date = .GetDisplayText(n, 73, 8)
Loop
If Date = RIP.Date Then
Result = .GetDisplayText(n, 32, 6)
excel.Range(BCELL).Select
excel.activecell.FormulaR1C1 = Result
End If
If Date <> RIP.Date Then
.TransmitTerminalKey rcIBMEnterKey
End If
Do Until Date = RIP.Date
Date = .GetDisplayText(9, 73, 8)
RIP.Date = .GetDisplayText(n, 73, 8)
Loop
Do Until RIP.Date = "        "
Loop

i = i + 1
c = Trim$(Str$(i))
ACELL = "A" + c
BCELL = "B" + c
CCELL = "C" + c
excel.Range(ACELL).Select
part = excel.activecell.FormulaR1C1
excel.Range(BCELL).Select
PLANT = excel.activecell.FormulaR1C1
excel.Range(CCELL).Select
COMMENT = excel.activecell.FormulaR1C1
excel.Range(dcell).Select
COMMENT2 = excel.activecell.FormulaR1C1
End With
End Sub

Answer 1

你的代码中有很多问题，让我们来看看：

很多：

excel.Range("A1").Select
excel.activecell.FormulaR1C1 = "PARTNO"

你可以用(更具可读性(替换它：

excel.Range("A1").FormulaR1C1 = "PARTNO"

第一：

i = 2
ACELL = "A2"

后来：

i = i + 1
c = Trim$(Str$(i))
ACELL = "A" + c

您也可以在开头使用它，因此请将第一个替换为：

i = 2
c = Trim$(Str$(i))
ACELL = "A" + c

for 循环未结束：

For n = 9 To 22
...
(Where's the Next, or the Step?)

可能的无限循环：

Do Until RIP.Date = "        "
Loop
(Two things: this is a possible endless loop, and second, what's with the list of spaces? You'd better say "... until Trim$(RIP.Date) = """)

大循环也没有结束：

Do Until partnumber = "                "
(same comment as above)

请进一步更正您的代码(因为您的代码甚至不会编译，因此几乎不可能进一步帮助您(.
最重要的是，我看到您混合了小写字母和大写字母。在Excel中，这不是问题，但其他编程语言可能有问题。请养成对所有变量使用相同的"大写"系统的好习惯。