Rocket Terminal Emulator

 View Only

 Macro Help

Robert Bessell's profile image
Robert Bessell posted 04-17-2024 03:05

Hi there

I have a Macro I need help with

Basically its a VBA Macro that I run from outlook.  It copies a value from the email, then activates the Passport Terminal Window and sends the command SHIFT+B as I have a macro assigned to the SHIFT+B Key

The problem is as soon as the VBA script I run from Excel processes the command  SendKeys "+B" it turns the numlock off

Adding a command to turn the numlock back on doesnt do anything

Any ideas?

Sub CopyDoc2()
    'Declare variables
    Dim objItem As Object
    Dim strBody As String
    Dim strSubject As String
    Dim strText As String
    Dim intStart As Integer
    Dim MyDataObject As MSForms.DataObject

    'Get selected email
    Set objItem = Application.ActiveExplorer.Selection.item(1)

    ' List of search terms
    Dim searchTerms As Variant
     searchTerms = Array("00S", "00C", "07C", "PPS", "08S", "22S")

    'Initialize variables
    strSubject = objItem.Subject
    strBody = objItem.Body
    Dim term As Variant
    Dim found As Boolean
    found = False

    ' Loop through search terms
    For Each term In searchTerms
        intStart = InStr(1, strSubject & strBody, term)
        If intStart > 0 Then
            'Copy found term and next 6 characters to clipboard
            strText = Mid(strSubject & strBody, intStart, 9)
            Set MyDataObject = New MSForms.DataObject
            MyDataObject.SetText strText
            MyDataObject.PutInClipboard
            'Mark message as category "BOB"
            objItem.UnRead = False
            objItem.Categories = ""
            objItem.Categories = "BOB"
            objItem.Save
            found = True
            Exit For
        End If
    Next term

    'If none of the terms are found, show error message
    If Not found Then
        MsgBox "None of the specified terms found in subject or body."
        Exit Sub
    End If

    'Cleanup
    Set objItem = Nothing

    'Activate the window by its title
    AppActivate "(B) DBSn.zws HAL-9000"

    'Send additional keystrokes
    SendKeys "+B"
    
End Sub