פתיחת תוכנת פרוייקט השו"ת על ידי מאקרו מוורד

[דאציג]

בהמשך לפוסט הזה: פקודת מאקרו בוורד שפותחת תוכנה אחרת ויכולה לעשות פעולות בתוך התוכנה האחרת

ולפי דברי

@OdedDvir כתב בפקודת מאקרו בוורד שפותחת תוכנה אחרת ויכולה לעשות פעולות בתוך התוכנה האחרת:

@dovid כתב בפקודת מאקרו בוורד שפותחת תוכנה אחרת ויכולה לעשות פעולות בתוך התוכנה האחרת:

@OdedDvir נדמה לי שזה בגלל שהCurrent Directory שלו לא מצביע על התיקיה של פרוייקט השות.

זו השערה הגיונית.
ניתן לאשש זאת על ידי בדיקה אם השגיאה נעלמת במקרה שהתוכנה כבר פתוחה ברקע לפני הרצת המאקרו.
אם כן, יש לשנות את התיקייה הפעילה לפני הפעלת האפליקציה, כלומר לשנות את הקוד כך:

Sub CopyAndPasteInResponsa()
    Selection.Copy
    Dim AppPid As Long
    AppPid = GetFirstPid("Responsa")
    If (AppPid = 0) Then
        ChDir "C:\Program Files (x86)\ResponsaCD25"
        AppPid = Shell("RESPONSA.exe", 1)
    End If
    AppActivate AppPid
    SendKeys "^Q", True
    SendKeys "^C", True
End Sub

הוספתי גם את הלחיצה על Q^ לפני ההדבקה.

הפקודה הזו מביאה לשגיאה כבר בשורה הזו:

  AppPid = GetFirstPid("Responsa")

ולפי מה שנראה לי, לא צריך לקרוא לקרוא לתוכנה לפי גרסה, אלא מספיק שם התוכנה.
כוונתי שלא צריך את השורה הזו:

 ChDir "C:\Program Files (x86)\ResponsaCD25"

מאוד יעזור שיהיה קוד כזה (שיתאים לכלל גרסאות פרוייקט השו"ת, ולא רק ל25), קיים כיום תוכנה דומה של רחמים שבעבר פורסמה כמאקרו, ששולחת טקסט שבזכרון לפרוייקט השו"ת והיא עובדת על כלל הגרסאות, (אפילו שנבנתה לפני שנים), כך שאני מבין שזה לא קשור.

יישר כוח

נ.ב. אני לא מבין לא בVBA, ולא בתוכנות.

[דאציג]

@האדם-החושב
ברוך ה' מצאתי!!!

@OdedDvir , תודה רבה!!!

זה עבד אצלי ככה:

Private Function GetFirstPid(applicationName As String) As Long
'Returns the FIRST PID of an application by it's name
    Dim services As Object, processes As Object, process As Object
    Dim resultPid As Long
 
    Set services = GetObject("winmgmts:\\.\root\CIMV2")
    Set processes = services.ExecQuery("SELECT ProcessID FROM Win32_Process WHERE name like ""%" & applicationName & "%""", , 48)
 
    For Each process In processes
       resultPid = process.ProcessID
       Exit For ' Just the first ID please :)
    Next
    ' Garbage cleanup
    Set processes = Nothing
    Set services = Nothing
    
    GetFirstPid = resultPid
End Function
 
Sub CopyAndPasteInResponsa()
    Selection.Copy
    Dim AppPid As Long
    AppPid = GetFirstPid("Responsa")
     AppActivate AppPid, True
        SendKeys ("^q"), True
       SendKeys ("^v"), True
       SendKeys ("{Enter}"), True
    End Sub

[דאציג]

אבל כמו ש @פרדס כתב כאן, לא תמיד זה עובד, אפילו שהוספתי True בסוף הפקודה...
משאלה במודל AI, קיבלתי תשובה שניתן להשתמש בAutoHotkey, אשמח לעזרת מי שמבין ויודע כיצד ניתן לעשות זאת.

תודה רבה!!!

[דאציג]

@האדם-החושב
לאחר שנים שעזבתי את זה, בקשתי בסוף שבוע שעבר מג'מיני שיכתוב לי משהו, והוא הצליח בצורה אחרת!
והנה דבריו:
זוהי תקלה קלאסית של SendKeys. מה שקורה זה שווינדוס שולח את האות "V" לפני שהספיק "להחזיק" את מקש ה-Ctrl בזיכרון של תוכנת היעד, ולכן במקום הדבקה מתקבלת האות עצמה.

כדי לפתור זאת בצורה מקצועית ויציבה, נשתמש בשיטה שנקראת Windows API. במקום "לבקש" מהמערכת ללחוץ על מקשים, אנחנו נדמה לחיצה פיזית על המקלדת. זה הרבה יותר אמין.

' הצהרות עבור המקלדת והשהיה
#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
    Public Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Public Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
#End If

' קבועים עבור המקשים
Const VK_CONTROL As Byte = &H11
Const VK_V As Byte = &H56
Const KEYEVENTF_KEYUP As Long = &H2

Sub תוכנת_חיפוש_מתוקן()
    On Error Resume Next
    
    ' 1. העתקה בטוחה מוורד
    Selection.Copy
    DoEvents
    Sleep 200 ' זמן קצר לוודא שהטקסט בלוח
    
    Dim AppPid As Long
    AppPid = GetFirstPid("Responsa")
    
    ' 2. מעבר לתוכנה
    If AppPid = 0 Then
        AppPid = Shell("C:\Program Files (x86)\ResponsaCD29\RESPONSA.exe", vbNormalFocus)
        Sleep 2500 ' המתנה ארוכה יותר להפעלה ראשונית
    Else
        AppActivate AppPid
        Sleep 600 ' זמן למערכת להעביר פוקוס לחלון
    End If
    
    On Error GoTo 0
    
    ' 3. שליחת F4 לפתיחת חלון החיפוש
    SendKeys "{F4}", True
    Sleep 500 ' המתנה קריטית לפתיחת תיבת הטקסט בתוכנה
    
    ' 4. הדבקה באמצעות דימוי לחיצת מקשים פיזית (Control + V)
    keybd_event VK_CONTROL, 0, 0, 0 ' לחיצה על Ctrl
    keybd_event VK_V, 0, 0, 0       ' לחיצה על V
    Sleep 100
    keybd_event VK_V, 0, KEYEVENTF_KEYUP, 0 ' שחרור V
    keybd_event VK_CONTROL, 0, KEYEVENTF_KEYUP, 0 ' שחרור Ctrl
    
    Sleep 300
    
    ' 5. אישור (Enter)
    SendKeys "{ENTER}", True
End Sub

Private Function GetFirstPid(applicationName As String) As Long
    Dim services As Object, processes As Object, process As Object
    Dim resultPid As Long
    Set services = GetObject("winmgmts:\\.\root\CIMV2")
    Set processes = services.ExecQuery("SELECT ProcessID FROM Win32_Process WHERE Name LIKE '%" & applicationName & "%'", , 48)
    For Each process In processes
       resultPid = process.ProcessID
       Exit For
    Next
    Set processes = Nothing
    Set services = Nothing
    GetFirstPid = resultPid
End Function

מה תיקנו כאן?
שימוש ב-keybd_event: במקום לשלוח פקודת ^v שמתפרשת לעיתים כסתם v, אנחנו אומרים למחשב: "תלחץ על קונטרול, עכשיו תלחץ על V, עכשיו תשחרר". זה מונע את כתיבת האות V.

הגדלת ה-Sleep אחרי ה-F4: בתוכנה שציינת, לעיתים לוקח לחלון החיפוש חצי שנייה להיפתח. אם ננסה להדביק מיד, הטקסט "ייזרק" לאוויר ולא ייכנס לתיבת הטקסט.

סדר פעולות: הוספנו DoEvents ו-Sleep קטן אחרי ההעתקה כדי לוודא שוורד לא "משחרר" את הפעולה לפני שהטקסט באמת מוכן בזיכרון.