VBS Если файл открыт

Question

У меня есть простая программа, чем сканирование данных в электронную таблицу вместе с меткой времени, тогда вы можете либо обновить данные, либо сохранить, либо выйти, и выйти и сохранить.

Единственная проблема, с которой я столкнулся в течение дня или около того, - это обойти обработку ошибок в случае, когда электронная таблица уже открыта. Id нравится иметь что-то подобное;

если файл открыт Then MsgBox («Файл открыт, закрыть файл и начать заново») WScript.Quit

Option Explicit 
DIM oFs: Set oFs = CreateObject("Scripting.FileSystemObject") 
DIM objExcel, strExcelPath, objSheet 
DIM ib 
DIM msg1 
DIM msg2 
strExcelPath = "c:\temp\Example.xls" 
Set objExcel = CreateObject("Excel.Application") 
objExcel.WorkBooks.Open strExcelPath 
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1) 

DO 
ib=inputbox("SCAN NAME, SCAN LOTS"&vbCrLf&"TO UPDATE,SCAN ""UPDATE."""&vbCrLf&"TO EXIT, SCAN ""QUIT.""","Picklot Passout Database") 
    IF ib="" THEN 
    msg1=MsgBox("You must scan either a NAME or LOT NUMBER."&vbCrLf&"If you want to exit, scan QUIT."&vbCrLf&"Click OK to continue.",vbokonly,"Cannot Insert Blank Data") 

    ELSEIF ib= "QUIT" OR ib= "quit" THEN 
      objExcel.ActiveWorkbook.Save 
      objExcel.ActiveWorkbook.Close 
      objExcel.Application.Quit 
      set objExcel = Nothing 
      Set oFs = Nothing 

     ELSEIF ib="update" OR ib="UPDATE" THEN 
      objExcel.ActiveWorkbook.Save 
      msg2=MsgBox("Update Complete.",vbokonly,"Database Updated") 
     ELSE 
      objSheet.Range("A2").EntireRow.Insert 
      objSheet.Cells(2, 1).Value = ib 
      objSheet.Cells(2, 2).Value=(now) 

      END IF 


    LOOP WHILE NOT ib="quit" AND NOT ib="QUIT" 

Answer 1

Это может помочь направить вас в правильном направлении. Извините за брошенный, строчный синтаксис и нетрадиционные отступы (не следуйте моей плохой практике - держите свое!: D), я написал его в блокноте, который вы видите, - но он был успешно протестирован.

Как бы то ни было, со ссылкой на ваш код, я изменил его неправильно, знакомый мне, добавив указанные функции. По сути, список приложений диспетчера задач проверяется на выполнение экземпляра «примерного» файла Excel (в зависимости от того, какая версия excel, которую вы используете синтаксис, будет отличаться).

Если найдено, это сделает его активным окном (тем самым предотвращая запуск только дублирующего экземпляра только для чтения). Если экземпляр не найден, он откроет «example.xlsx», в этом случае используя относительный путь к самому скрипту. Затем подпрограмма вызывается для ведения бизнеса с ячейками ...

Я написал ее таким образом, чтобы попытаться сохранить ваши спецификации, а также поддерживать кнопки «ОК» и «Отмена», явно функциональные. Пожалуйста, не стесняйтесь возиться с этим, вам может потребоваться обратиться по адресу path и instr. Я надеюсь, что это помогает! Всего наилучшего.

path=createobject("scripting.filesystemobject").getparentfoldername(wscript.scriptfullname) 
excelpath=path&"\example.xlsx" 

set objword=createobject("word.application") 
set coltasks=objword.tasks 
i=0 

for each objtask in coltasks 
    name=lcase(objtask.name) 
    if instr(name, "microsoft excel - example") then 
    i=1 
    end if 
next 

    if i=1 then 
    wscript.echo "An active instance of ""example.xlsx"" has been found" 
    set objexcel=getobject(excelpath) 
    call UPDATER 

    else 
    set objexcel=createobject("excel.application") 
    objexcel.workbooks.open(excelpath) 
    set objsheet=objexcel.activeworkbook.worksheets(1) 
    objexcel.visible=true 
    call UPDATER 
    end if 


sub UPDATER 
do 
data=inputbox("Please enter data" &vbcrlf&vbcrlf& "To save data & continue, type ""update""" &vbcrlf& "To save data & exit, type ""quit""","Excel DB Updater") 
    if isempty(data) then 
    objexcel.activeworkbook.close 
    objexcel.application.quit 
    wscript.quit() 

    elseif lcase(data)="quit" then 
    objexcel.activeworkbook.save 
    objexcel.activeworkbook.close 
    objexcel.application.quit 
    quit=msgbox("DB Updating complete",vbokonly,"Excel DB Updater") 
    wscript.quit 

    elseif lcase(data)="update" then 
    objexcel.activeworkbook.save 
    update=msgbox("Data save complete, press OK to continue",vbokonly,"Excel DB Updater") 

    elseif len(data)<>0 then 
    objsheet.range("A1").entirerow.insert 
    objsheet.cells(1, 1).value=data 
    objsheet.cells(1, 2).value=(now) 
    add=msgbox("Data added, press OK to continue",vbokonly,"Excel DB Updater") 
    end if 
loop while len(data)>=0 and not lcase(data)="quit" 
end sub