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

[האדם החושב]

@OdedDvir מסתבר שזה לא יעבוד באוצר החכמה בלי להוסיף אותו למשתני הסביבה ,לא?

[OdedDvir]

@האדם-החושב הפקודה AppActivate אינה תלויה במשתני הסביבה, רק בשם האפליקציה.
הפקודה הנ"ל פשוט מחפשת את החלון עם השם המתאים והופכת אותו ליישום הפעיל (ציינתי שכתנאי מקדים האפליקציה חייבת להיות פתוחה ברקע)

[האדם החושב]

לגבי החיפוש באוצר החכמה ובר אילן:
ניסיתי היום על בר אילן בכמה אופנים ותכלס' לא עובד:
א:

Option Explicit

Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr

Sub OpenWebPage()
    SendKeys "^C", True 'העתק בחירה
    Dim url As String
    url = "C:\Program Files (x86)\ResponsaCD25\RESPONSA.exe" 'Replace with the URL of the webpage you want to open
    ShellExecute 0, "open", url, vbNullString, vbNullString, vbNormalFocus 'הפעל את בר אילן
    SendKeys "^O", True 'פתח חיפוש
    SendKeys "^V", True 'הדבק
    SendKeys "{ENTER}", True 'בצע חיפוש
End Sub

אני מקבל את השגיאה הבאה:

[ניסיתי את זה על בר אילן 25 ,גם כשניסיתי לפתוח את התוכנה ע"י הקלדת הנתיב בcmd קיבלתי את אותה שגיאה]

ב:

Sub חיפוש_בספרים_בר_אילן()
SendKeys "^C", True 'העתק בחירה
Shell "C:\Program Files (x86)\ResponsaCD25\RESPONSA.exe", True 'הפעל את בר אילן
SendKeys "^O", True 'פתח חיפוש
SendKeys "^V", True 'הדבק
SendKeys "{ENTER}", True 'בצע חיפוש

End Sub

ג:

Sub חיפוש_בספרים_בר_אילן()
    SendKeys "^C", True 'העתק בחירה
AppActivate "RESPONSA", True 'הפעל את בר אילן
    SendKeys "^O", True 'פתח חיפוש
    SendKeys "^V", True 'הדבק
    SendKeys "{ENTER}", True 'בצע חיפוש
End Sub

בשניהם קיבלתי את השגיאה הבאה:

@OdedDvir
אולי לא הכנסתי את ה AppActivate הנכון? ,איפה אני רואה אותו [הכנסתי לפי מה שמופיע במנהל המשימות]

[OdedDvir]

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

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")
    If (AppPid = 0) Then
        AppPid = Shell("C:\Program Files (x86)\ResponsaCD25\RESPONSA.exe", 1)
    End If
    AppActivate AppPid
    SendKeys ("^C")
End Sub

[האדם החושב]

@OdedDvir עכשיו אני מקבל את השגיאה הזאת:

וכשלחצתי על הודעה מפורטת זה מה שהופיע לי:

כשהרצתי את זה כשהתוכנה היתה פתוחה החלון של התוכנה נפתח ,אבל לא נפתח לי החלון חיפוש [שנפתח ע"י קונטרול Q]
הקוד היה כזה:

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 חיפוש_בספרים()
    Selection.Copy
    Dim AppPid As Long
    AppPid = GetFirstPid("Responsa")
    If (AppPid = 0) Then
        AppPid = Shell("C:\Program Files (x86)\ResponsaCD25\RESPONSA.exe", 1)
    End If
    AppActivate AppPid
    SendKeys "^O", True
    SendKeys "^V", True 'הדבק
    SendKeys "{ENTER}", True 'בצע חיפוש
End Sub

כלומר הוא מריץ את זה לפני שהתוכנה נפתחת?
תודה רבה

[OdedDvir]

@האדם-החושב

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

   כלומר הוא מריץ את זה לפני שהתוכנה נפתחת?

4. לא הבנתי את השאלה.

[האדם החושב]

@OdedDvir

צירפת שתי תמונות, כל אחת עם קוד שונה.

לא היה לי צילום מסך מהקוד הנוכחי, אבל זאת אותה שגיאה

לא ציינת איזו שורה גורמת לשגיאה.

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

לא הבנתי את השאלה

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

[dovid]

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

[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^ לפני ההדבקה.

[דאציג]

פוסט זה נמחק!