VBScript+SCR+NetApi+Accoreconsole 批处理dwg文件

继上次powershell运行accoreconsole(https://www.cnblogs.com/NanShengBlogs/p/10981687.html)的研究之后又觉得不是很合适，毕竟powershell还存在权限问题，不像vbs这么windows原生的的脚本好用。

脚本主要部分

 

Option Explicit

Dim acoreFn,fso

acoreFn=inputbox("输入AutoCAD的版本号","用户输入","2019")

if int(acoreFn)>=2013 then 

    Set fso = CreateObject("Scripting.FileSystemObject")

    if fso.FileExists("C:\Program Files\Autodesk\AutoCAD " & acoreFn & "\accoreconsole.exe") then
    
        acoreFn=chr(34) & "C:\Program Files\Autodesk\AutoCAD " & acoreFn & "\accoreconsole.exe" &chr(34)
        
        call AccoreCmdExecute("myScrFile.scr",acoreFn)
    else
    
        msgbox "请确认本机的autocad"& int(acoreFn) & "安装路径为：" & vbNewLine & "C:\Program Files\Autodesk\AutoCAD " & acoreFn & "",vbError+vbOKOnly
        
    end if
    
else
    msgbox "Accoreconsole.exe 程序从AutoCAD2013 开始支持！",vbError+vbOKOnly
    
end if

set fso=nothing

public sub AccoreCmdExecute(scrFileName,accoreconsoleFileName)

    Dim objFSO,curFdName,fl,fd,WshShell,scrFile,args

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    curFdName = objFSO.GetFile(WScript.ScriptFullName).ParentFolder

    scrFile=" /s " & chr(34) & curFdName & "\" & scrFileName & chr(34)
    
    set fd=objFSO.GetFolder(curFdName)
    
        
    Set WshShell=Wscript.CreateObject("Wscript.Shell")
    
    for each fl in fd.Files

        if LCase(objFSO.GetExtensionName(fl))="dwg" then
            
            if (objFSO.getfile(fl).Attributes and 1) or CheckFileInuse(fl)=true then 
            
                msgbox fl.name & "是只读文件或者被打开,无法执行脚本命！"
            else
                args=" /i " & chr(34) & curFdName& "\" & fl.name & chr(34)
            
                WshShell.run accoreconsoleFileName & args & scrFile,0,false
            
                msgbox fl.name & "执行完成!"
                
            end if

        end if
    next

    set fd=nothing
    set objFSO=nothing
    set WshShell=nothing

end sub

public function CheckFileInuse(fn)

    dim fso,fl
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set fl = fso.GetFile(fn)
    
    ON ERROR RESUME NEXT
    
    fl.move fl.path
    
    if Err=70 then 
    
        CheckFileInuse=true
    else 
        CheckFileInuse=false
    end if

    Set fso =nothing
    
    Set fl = nothing
    
end function

 执行命令的部分

 检查文件名是否被打开。