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

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

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

以管理员身份运行程序的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 = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
'---- LockTypeEnum Values ----

Const adLockReadOnly = 1

Const adLockPessimistic = 2

Const adLockOptimistic = 3

Const adLockBatchOptimistic = 4
'---- CuRsorLocationEnum Values ----

Const adUseServer = 2

Const 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 Function
Function 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 If

End Function

VBS批量删除图片功能

'****************** Const ****************
'---- CuRsorTypeEnum Values ----
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
'---- LockTypeEnum Values ----

Const adLockReadOnly = 1

Const adLockPessimistic = 2

Const adLockOptimistic = 3

Const adLockBatchOptimistic = 4
'---- CuRsorLocationEnum Values ----

Const adUseServer = 2

Const 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 Function
Function 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 If

End Function

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

                        友情连接： 

创业项目排行榜前十名

美文集

茂名一技

茂名一技

手游排行前十名