最近在項目中使用VBS來實現圖片的批量刪除和批量導入功能，但不知道為什么，只要在我機器上一運行VBS文件就提示“沒有在該機執行windows腳本宿主的權限。請與系統管理員聯系。”的錯誤。下面貼出本人的解決方法，并附上圖片批量導入及批量刪除的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批量導入圖片功能
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
'****************** 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批量刪除圖片功能
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
'****************** 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腳本宿主的權限內容請搜索服務器之家以前的文章或繼續瀏覽下面的相關文章希望大家以后多多支持服務器之家！
原文鏈接：https://www.cnblogs.com/dreamof/archive/2008/11/06/1328083.html
