最近在項目中使用VBS來實現(xiàn)圖片的批量刪除和批量導入功能，但不知道為什么，只要在我機器上一運行VBS文件就提示“沒有在該機執(zhí)行windows腳本宿主的權限。請與系統(tǒng)管理員聯(lián)系。”的錯誤。下面貼出本人的解決方法，并附上圖片批量導入及批量刪除的VBS代碼。
如果只是因為權限問題可以查看這篇文章：
以管理員身份運行程序的vbs命令
1、檢查系統(tǒng)是否禁止使用了腳本運行，即打開“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 "數(shù)據庫聯(lián)接失敗",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 文件總數(shù)
Dim PicPath,PhysicPath,DelCount '刪除文件數(shù)
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 "數(shù)據庫聯(lián)接失敗",16 ,"照片刪除"
exit function
End If
End Function
到此這篇關于vbs提示沒有在該機執(zhí)行windows腳本宿主的權限。請與系統(tǒng)管理員聯(lián)系的文章就介紹到這了,更多相關windows腳本宿主的權限內容請搜索腳本之家以前的文章或繼續(xù)瀏覽下面的相關文章希望大家以后多多支持腳本之家！
