פתיחת תוכנת פרוייקט השו"ת על ידי מאקרו מוורד
-
בהמשך לפוסט הזה: פקודת מאקרו בוורד שפותחת תוכנה אחרת ויכולה לעשות פעולות בתוך התוכנה האחרת
ולפי דברי
@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