vbs提示没有在该机执行windows脚本宿主的权限。请与系统管理员联系

最近在项目中使用vbS来实现图片的批量删除和批量导入功能，但不知道为什么，只要在我机器上一运行VBS文件就提示“没有在该机执行windows脚本宿主的权限。请与系统管理员联系。”的错误。下面贴出本人的解决方法，并附上图片批量导入及批量删除的VBS代码。

如果只是因为权限问题可以查看这篇文章：

以管理员身份运行程序的vbs命令

1、检查系统是否禁止使用了脚本运行，即打开“internet选项”的“安全”选项卡里“自定义级别”，看看“ActiveX空件及服务”禁用的选项。
2、运行 regsvr32 scrrun.dll，即打开运行输入CMD，输入regsvr32 scrrun.dll，再回车。
3、最关键的一步，即看看注册表里的这个位置HKEY_LOCAL_MACHINE\Software\Microsoft\Windows Script Host\Settings在右边的窗口中是不是有个名为 Enabled的DWORD键值,有的话把它删除或者把值该为 1 即可。
4、重新运行VBS文件即将正常。

VBS批量导入图片功能

'****************** Const ****************'---- CuRsorTyPEEnum Values ----Const adOpenForwardOnly = 0Const adOpenKeyset = 1Const adOpenDynamic = 2Const adOpenstatic = 3'---- LockTypeEnum Values ----Const adLockReadOnly = 1Const adLockPessimistic = 2Const adLockOptimistic = 3Const adLockBatchOptimistic = 4'---- CuRsorLocationEnum Values ----Const adUseServer = 2Const adUseClient = 3'---- Custom Values ----Const cuDSN = "test"Const cuUsername = "sa"Const cuPassword = ""'*************** main sub ******************Call Imageexport()'*************** define function ***********Function ImageExport()  'on error resume next  Dim sSQL,Rs,Conn,sfzRs,sFilePath,simgFile,XMl  Dim ADOS,fso,f,oShell,sErrFile,sSuCFile,iErr,iSuc  Set fso = CreateObject("Scripting.FileSystemObject")      ' Create Stream Object  set Ados=CreateObject("Adodb.Stream")    Ados.Mode=3    Ados.Type=1  Set Conn=CreateObject ("adodb.Connection")  Conn.CuRsorLocation =adUseClient  Call InIT_Connection(Conn)  Set Rs=CreateObject ("adodb.recordset")  Set sfzRs=CreateObject ("adodb.recordset")    sFilePath=WScript.ScriptFullName  sFilePath=left(sFilePath,len(sFilePath)-len(WScript.ScriptName))  ssql="SELECT RYBH, PHOTO From TP_ZPXX WHERE (RYBH IN (SELECT DISTINCT RYBH From TP_BMKM WHERE (KSZQBH = 18) AND (JFBZ = 1)))"  sfzRs.Open sSQL,Conn,adOpenForwardOnly   iSuc=sfzRs.RecordCount     'Get SFZH From DataBase and import images  while not sfzRs.EOF     sImgFile= sFilePath &
     sfzRs("RYBH") &
     ".jpg"      Ados.Open         Ados.Write (sfzRs("PHOTO").GetChunk(4500000))        Ados.SaveToFile sImgFile,1         sfzRs.MoveNext         Ados.Close   wend     sfzRs.Close   Conn.Close     'Release Object  set Rs=nothing:set sfzRs=nothing:set Conn=nothing:set Ados=nothing    msgbox iSuc &
     "张照片导出成功",64 ,"照片导出"        'Quit   WScript.Quit  End FunctionFunction Init_Connection(Conn)  on error resume next  ConnStr = "PRovider=SQLOLEDB;
    Data Source=192.168.64.114;
    " &
     _        "Initial CataLOG=Voteinfo;
    User Id=sa;
    Password=123456;
    timeout=50"  Conn.Open ConnStr    If Err.number Then        msgbox "数据库联接失败",16 ,"照片导出"    exit function  End IfEnd Function

VBS批量删除图片功能

'****************** Const ****************'---- CuRsorTypeEnum Values ----Const adOpenForwardOnly = 0Const adOpenKeyset = 1Const adOpenDynamic = 2Const adOpenStatic = 3'---- LockTypeEnum Values ----Const adLockReadOnly = 1Const adLockPessimistic = 2Const adLockOptimistic = 3Const adLockBatchOptimistic = 4'---- CuRsorLocationEnum Values ----Const adUseServer = 2Const adUseClient = 3'---- Custom Values ----Const cuDSN = "test"Const cuUsername = "sa"Const cuPassword = ""'*************** main sub ******************Call ImageExport()'*************** define function ***********Function ImageExport()  'on error resume next  Dim sSQL,Rs,Conn,sfzRs,xML  Dim Ados,fso,f,oShell,sErrFile,sSucFile,iErr,iSuc  'iSuc 文件总数  Dim PicPath,PhysicPath,DelCount '删除文件数  Set fso = CreateObject("Scripting.FileSystemObject")      ' Create Stream Object  set Ados=CreateObject("Adodb.Stream")    Ados.Mode=3    Ados.Type=1  Set Conn=CreateObject ("adodb.Connection")  Conn.CuRsorLocation =adUseClient  Call Init_Connection(Conn)  Set Rs=CreateObject ("adodb.recordset")  Set sfzRs=CreateObject ("adodb.recordset")      sSQL="select sPath,sFile from ScanFile"  sfzRs.Open sSQL,Conn,adOpenForwardOnly   iSuc=sfzRs.RecordCount     'Get SFZH From DataBase and import images  while not sfzRs.EOF     PhysicPath="E:\VBS删除照片小程序" '物理路径        Ados.Open       PicPath =PhysicPath &
     sfzRs("sPath") &
    "\" &
      sfzRs("sFile")        If (fso.FileExists(PicPath)) Then      fso.DeleteFile(PicPath)        DelCount=DelCount+1    end if        sfzRs.MoveNext         Ados.Close     if iSuc-DelCount=iSuc Then      DelCount=0    end if      wend     sfzRs.Close   Conn.Close     'Release Object  set Rs=nothing:set sfzRs=nothing:set Conn=nothing:set Ados=nothing:set fso=nothing    msgbox "共需要删除" &
     iSuc &
     "张照片,其中" &
     DelCount &
     "张照片删除成功," &
    iSuc-DelCount &
     "张照片未找到！",64 ,"照片删除"        'Quit   WScript.Quit  End FunctionFunction Init_Connection(Conn)  on error resume next  ConnStr = "Provider=SQLOLEDB;
    Data Source=192.168.64.114;
    " &
     _        "Initial Catalog=VoteInfo;
    User Id=sa;
    Password=123456;
    timeout=50"  Conn.Open ConnStr    If Err.number Then        msgbox "数据库联接失败",16 ,"照片删除"    exit function  End IfEnd Function

到此这篇关于vbs提示没有在该机执行windows脚本宿主的权限。请与系统管理员联系的文章就介绍到这了,更多相关windows脚本宿主的权限内容请搜索以前的文章或继续浏览下面的相关文章希望大家以后多多支持！

声明：本文内容由网友自发贡献，本站不承担相应法律责任。对本内容有异议或投诉，请联系2913721942#qq.com核实处理，我们将尽快回复您，谢谢合作！