Меню

Ошибка выполнения vbs script разрешение отклонено

  • Remove From My Forums
  • Question

  • I’m so close to get my script to work with a user, but I need your help.
    I have a Terminal Server 2003 with policy restrictions. My users can’t even see how much megabytes they have in use. So I created the following script. It runs perfectly with an administrator account:


    Dim oFS, oFolder
    Dim total
    Dim message
    set oFS = WScript.CreateObject(«Scripting.FileSystemObject»)
    set oFolder1 = oFS.GetFolder(«\servershare$»)
    set oFolder2 = oFS.GetFolder(«\servershare1$»)
    set oFolder3 = oFS.GetFolder(«\servershare2$»)
    Wscript.Sleep 300
    total = oFolder1.Size + oFolder2.Size + oFolder3.Size
    message=MsgBox («Size: » & vbTab & oFolder1.Size /10241024 & «MB» & vbTab & » Path: » & vbTab & oFolder1.Path & Chr(10) _
    & «Size: » & vbTab & oFolder2.Size /10241024 & «MB» & vbTab & » Path: » & vbTab & oFolder2.Path & Chr(10) _
    & «Size: » & vbTab & oFolder3.Size /10241024 & «MB» & vbTab & » Path: » & vbTab & oFolder3.Path & Chr(10) _
    & «Total: » & vbTab & total /10241024 & «MB»,64,»megabytes in use»)

    The problem I’m facing is that I can’t distribute it to my users because when this script runs as an user I receive this error:
    Windows Script Host
    Script: pathandname.vbs
    Line: 9
    Char: 1
    Error: Permission denied
    Code: 800A0046
    Source: Microsoft VBScript runtime error

    I’ve checked the users permission on the servershare’s and they have Full Control.
    Also on the ACL on the script the user has Full Control.

    What else can I check?
    Is there a setting in some GPO that denies users to run a .vbs?

    Please let me know when you need more information to solve this.

    Cheers,
    Yuri

Answers

  • Are you sure the users have permissions to ALL files and directories on the shares?
    If there is as much as one file or folder to which the user hasn’t got at least «list contents» permission the script will fail with the above message.

    If you check the properties of the root of the share from explorer, first as an administrator and then as a user. Does it show the same amount of files/folders and the same size?
    A difference here would indicate that the user doesn’t have permissions to everything.

    • Marked as answer by

      Tuesday, September 1, 2009 9:14 AM

Skydiver_vrn

0 / 0 / 0

Регистрация: 01.07.2014

Сообщений: 14

1

VBS

Разрешение отклонено

01.07.2014, 09:03. Показов 24153. Ответов 11

Метки нет (Все метки)


Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Set FSO = CreateObject("Scripting.FileSystemObject")
path="D:share123"
  if (FSO.FolderExists(path) = true) then 
    Set Folder = FSO.GetFolder(path)
    For Each SubFolder In Folder.SubFolders
     folder1=SubFolder.Name
     if folder1<>"Маркетинг" and folder1<>"111" and folder1<>"222" and folder1<>"333" and folder1<>"444" and folder1<>"555" and folder1<>"666" and folder1<>"777" and folder1<>"888" then
      folder1=path+folder1
       if (FSO.FolderExists(folder1) = true) then 
        Set folder_for_delete = FSO.GetFolder(folder1)
        folder_for_delete.Delete(True)
       else MsgBox "Путь "+folder1+" не найден" 
       end if
     end if 
    Next
  end if

Вот такой скрипт, ругается на строка 11 символ 9 разрешение отклонено

__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь



0



2617 / 547 / 109

Регистрация: 21.03.2012

Сообщений: 1,051

01.07.2014, 10:11

2

Цитата
Сообщение от Skydiver_vrn
Посмотреть сообщение

… разрешение отклонено

Причина — отсутствуют необходимые полномочия. Проверяйте список управления доступом для соответствующей папки.



0



0 / 0 / 0

Регистрация: 01.07.2014

Сообщений: 14

01.07.2014, 11:54

 [ТС]

3

Dmitrii, Так запускаю скрипт вручную под доменным админом у которого есть все права на эту папку.

Добавлено через 1 час 40 минут
Dmitrii, Поигрался с правами, теперь пишет «путь не найден» Строка 11 символ 9



0



2617 / 547 / 109

Регистрация: 21.03.2012

Сообщений: 1,051

01.07.2014, 18:29

4

Цитата
Сообщение от Skydiver_vrn
Посмотреть сообщение

… под доменным админом у которого есть все права на эту папку

1. Какая версия ОС?
2. Включен ли UAC?

Цитата
Сообщение от Skydiver_vrn
Посмотреть сообщение

Поигрался с правами, теперь пишет «путь не найден»

Покажите подробный список управления доступом. Для каждой записи должны быть видны: тип, маска доступа, точка наследования, область действия.



0



Skydiver_vrn

0 / 0 / 0

Регистрация: 01.07.2014

Сообщений: 14

02.07.2014, 08:17

 [ТС]

5

Dmitrii, С доступом вроде разобрался сам, сегодня скрипт отработал ночью запускал через bat-ник

Bash
1
2
del D:Share123*.* /q /f
C:cmdclear_share.vbs

но удалились только файлы которые были вне папок, папки на месте остались, и новая ошибка «Предполагается наличие Then строка 7 символ 174»

Добавлено через 12 минут
И тут затупил сам тоже, не написал and когда ещё пункт добавил. Сегодня ночью ещё раз попробую.



0



0 / 0 / 0

Регистрация: 01.07.2014

Сообщений: 14

03.07.2014, 14:52

 [ТС]

6

Dmitrii, Снова удалились только файлы, никакой ошибки не выскочило. Помогите пожалуйста, я чайник в написании скриптов.

Добавлено через 5 часов 55 минут
Причём часть папок удалилась, а как только дошёл до первой в списке исключений остальные на месте.



0



Dmitrii

2617 / 547 / 109

Регистрация: 21.03.2012

Сообщений: 1,051

04.07.2014, 20:47

7

Попробуйте такой вариант:

Кликните здесь для просмотра всего текста

Visual Basic
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
Dim objFS, objFolder, objItem, strPath, strExclude, strLog, strTemp
 
strExclude = "Маркетинг;111;222;333;444;555;666;777;888;"
Set objFS = CreateObject("Scripting.FileSystemObject")
strPath = "D:share123"
If objFS.FolderExists(strPath) Then 
    Set objFolder = objFS.GetFolder(strPath)
    On Error Resume Next
    If objFolder.SubFolders.Count > 0 Then
        For Each objItem In objFolder.SubFolders
            If InStr(1, strExclude, objItem.Name & ";", vbTextCompare) = 0 Then
                strTemp = objItem.Path
                objItem.Delete True
                If Err.Number = 0 Then
                    strLog = strLog & strTemp & " -> успех" & vbNewLine
                Else
                    strLog = strLog & strTemp & " -> ошибка: " & Err.Description & vbNewLine
                    Err.Clear
                End If
            End if 
        Next
    Else
        strLog = "Папка " & strPath & " не содержит ни одной подпапки."
    End If
    Set objFolder = Nothing
Else
    strLog = "Не найден путь " & strPath
End if
strTemp = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), "Results.txt")
Set objItem = objFS.CreateTextFile(strTemp, True)
If Err.Number = 0 Then
    If Len(strLog) > 0 Then
        objItem.Write strLog
    Else
        objItem.Write "Папка " & strPath & " не содержит ни одной подпапки, предназначенной для удаления."
    End If
    objItem.Close
    WScript.Echo "Готово. Журнал здесь:" & vbNewLine & strTemp
Else
    WScript.Echo "Готово. Ошибка при создании журнала:" & vbNewLine & Err.Description
    Err.Clear
End If
Set objItem = Nothing: Set objFS = Nothing
WScript.Quit 0



2



ComSpec

3455 / 1993 / 635

Регистрация: 26.02.2014

Сообщений: 1,457

04.07.2014, 22:27

8

Dmitrii, поправки:

Visual Basic
1
strExclude = ";Маркетинг;111;222;333;444;555;666;777;888;"
Visual Basic
1
If InStr(1, strExclude, ";" & objItem.Name & ";", vbTextCompare) = 0 Then

.
Иначе не удалятся папки с именами «1», «2», «3», «4», «5», «6», «7», «8», «11», «22», «33», «44», «55», «66», «77», «88», «аркетинг», «ркетинг», «кетинг», «етинг», «тинг», «инг», «нг», «г».



3



Эксперт WindowsАвтор FAQ

17951 / 7587 / 889

Регистрация: 25.12.2011

Сообщений: 11,317

Записей в блоге: 17

05.07.2014, 14:21

9

Вот такая папка тоже не удалится «111;222»
Нужно все разделители ; заменить на символ, который нельзя использовать в именовании ФС, например |



3



Dmitrii

2617 / 547 / 109

Регистрация: 21.03.2012

Сообщений: 1,051

06.07.2014, 21:37

10

Лучший ответ Сообщение было отмечено Skydiver_vrn как решение

Решение

С учётом справедливых замечаний от ComSpec и Dragokas имеем следующий вариант:

Кликните здесь для просмотра всего текста

Visual Basic
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
Dim objFS, objFolder, objItem, strPath, strExclude, strLog, strTemp
 
strExclude = "*Маркетинг*111*222*333*444*555*666*777*888*"
Set objFS = CreateObject("Scripting.FileSystemObject")
strPath = "D:share123"
If objFS.FolderExists(strPath) Then 
    Set objFolder = objFS.GetFolder(strPath)
    On Error Resume Next
    If objFolder.SubFolders.Count > 0 Then
        For Each objItem In objFolder.SubFolders
            If InStr(1, strExclude, "*" & objItem.Name & "*", vbTextCompare) = 0 Then
                strTemp = objItem.Path
                objItem.Delete True
                If Err.Number = 0 Then
                    strLog = strLog & strTemp & " -> успех" & vbNewLine
                Else
                    strLog = strLog & strTemp & " -> ошибка: " & Err.Description & vbNewLine
                    Err.Clear
                End If
            End if 
        Next
    Else
        strLog = "Папка " & strPath & " не содержит ни одной подпапки."
    End If
    Set objFolder = Nothing
Else
    strLog = "Не найден путь " & strPath
End if
strTemp = objFS.BuildPath(objFS.GetParentFolderName(WScript.ScriptFullName), "Results.txt")
Set objItem = objFS.CreateTextFile(strTemp, True)
If Err.Number = 0 Then
    If Len(strLog) > 0 Then
        objItem.Write strLog
    Else
        objItem.Write "Папка " & strPath & " не содержит ни одной подпапки, предназначенной для удаления."
    End If
    objItem.Close
    WScript.Echo "Готово. Журнал здесь:" & vbNewLine & strTemp
Else
    WScript.Echo "Готово. Ошибка при создании журнала:" & vbNewLine & Err.Description
    Err.Clear
End If
Set objItem = Nothing: Set objFS = Nothing
WScript.Quit 0



2



0 / 0 / 0

Регистрация: 01.07.2014

Сообщений: 14

15.07.2014, 11:19

 [ТС]

11

Всем огромное спасибо! Всё работает. А может стоит куда то вынести сей скрипт, он же достаточно универсальный, может ещё какойнибудь такойже как я чайник сможет применить в своей системе…



0



Эксперт WindowsАвтор FAQ

17951 / 7587 / 889

Регистрация: 25.12.2011

Сообщений: 11,317

Записей в блоге: 17

15.07.2014, 13:47

12

Skydiver_vrn, в принципе можно. Добавил.



0



The Microsoft VBScript runtime error: Permission denied 800A0046, may faced while trying to install or uninstall a program or driver on your computer. The error 800A0046 is commonly caused because you ‘ll try to install a program on your computer without having administrative privileges or because you have enabled the User Account Control (UAC) on Windows 7 or Vista based computers. 

Permission denied 800A0046

In most cases the VBScript runtime error 800A0046, is occurred whenever you try to install the «Windows Installer Clean Up» utility, in order to remove a program from the system that you cannot uninstall by using the normal way (Programs and features).

This article contains two(2) methods to fix the «Permission denied 800A0046» Windows Script Host Error, on Windows 7 or Vista.

How to bypass the Windows Script Host «Permission Denied – Code 800A0046».

Before applying the methods below to resolve the VBScript Runtime 800A0046 error, first make sure that you have logged on as Administrator on your system,

Method 1: DISABLE User Account Control (UAC).

In order to disable the UAC (User Account Control):

1. Go to Start > Control Panel.
2. Open User Accounts.
3. Click at Change User Account Control settings.

VBScript Runtime error 800A0046

4, Move the slider on the left to Never notify and click OK.
5. Restart your computer.

disable uac - user account control

6. After restart, install (or uninstall) the program that caused the 800A0046 error.

Method 2: RUN the Installer (Setup.exe) as Administrator

In order to install a program as administrator:

1. Right click at the program (installer) that you ‘re trying to install and click Run as Administrator.

run as adminsitrator

That’s all folks! Did it work for you?

Please leave a comment in the comment section below or even better: like and share this blog post in the social networks to help spread the word about this solution.

If this article was useful for you, please consider supporting us by making a donation. Even $1 can a make a huge difference for us.

Troubleshooting Code 800A0046 – Permission Denied

Code 800A0046 is a straightforward error to solve.  The secret is to read the Windows Script Error message carefully, then check the access control list to see who has permission to use the page, or use the device.

  • Introduction to Error Code 800A0046
  • Example 1: Script to map a printer
  • Example 2: Error 800A0046 When You Install Visual Studio
  • Permissions Analyzer Free Tool

  ‡

Introduction to Error 800A0046

Code 800A0046 is runtime error that is more likely to occur with an .ASP file than a .VBS.  You could be trying to connect to SQL, IIS or Exchange.  However, my example of is taken from printer permission problem sent in by Keith S.Code Error 800A0046 Permission Denied

The Symptoms You Get With Error 800A0046

When you get a pop-up message box.  Put on your detective hat, and pay close attention to the line number.  Error 800A0046 is a runtime error, so the problem is likely to outside your script, there could be something the matter with permissions on an application server.

The Cause of Error 800A0046

In the example above, Line 6: is the source of the error.  Char 1: is not always very useful as the error could be anywhere on the line, and WSH still blames char 1.

The cause of error 800A0046 is likely to be read-only permissions on some aspect of your server.  The Source: tells us that this is a runtime error, therefore the syntax is probably o.k.

The Solution

If its Exchange, then check the MailRoot and Pickup folder permissions.  If its IIS check the permissions to run scripts.  If its SQL check the execute permissions on the services.

The solution in the printer problem below would be to change the share permissions on the HP6L printer share.

Example 1: Script to map a printer

In this example, the user does not have permission to install the HP6L printer. Tell the truth, an example script is not that useful with Error 800A0046 as you cannot see the permissions!

‘  VBScript to create a local printer mapped to a network server
‘  Guy Thomas February 2010.
Option Explicit
Dim netPrinter
Set netPrinter = CreateObject(«WScript.Network»)
netPrinter.AddWindowsPrinterConnection «\ServerPrnHP6L»

Guy Recommends: Permissions Analyzer – Free Active Directory ToolFree Permissions Analyzer for Active Directory

I like thePermissions Monitor because it enables me to see quickly WHO has permissions to do WHAT.  When you launch this tool it analyzes a users effective NTFS permissions for a specific file or folder, takes into account network share access, then displays the results in a nifty desktop dashboard!

Think of all the frustration that this free utility saves when you are troubleshooting authorization problems for users access to a resource.  Give this permissions monitor a try – it’s free!

Download Permissions Analyser – Free Active Directory Tool

Example 2: Error 800A0046 When You Install Visual Studio 6.0 (Also other Microsoft Products)

When you install Visual Studio you get the following message.

Permission denied: ‘CreateObject’

/Retail/include/global_siteconfig_lib.asp, line 194

Once again it’s a permissions problem on the Windowssystem32 folder.  Another idea is to try the useful Free Permissions Analyzer.

Example 3: ASP on IIS (Kindly sent in by a reader)

The way we got error 800A0046 was running ASP on IIS under Server 2003R2. Someone wrote a debug routine that did an OpenTextFile from a FileSystemObject; I think what happened was there were multiple simultaneous attempts to open that file.

Example 4: Constantly Writing to File

Dim FSO
Dim oFS
CONST F_ATTR_RONLY = 1
Set FSO = CreateObject(«Scripting.FileSystemObject»)
Set oFS = FSO.GetFile(«d:testo2test.png»)
IF oFS.Attributes AND F_ATTR_RONLY ‘check if bit 1 is set – read only
THEN
‘do nothing
ELSE
FSO.CopyFile «d:testo1test.png», «d:testo2»
END IF

The problem was: the file is written into the sourcelocation every 10 seconds. This is done by a Closed Source Software i have no way of editing. It seems like i get the error (line 11) every time i try to READ the sourcefile while it is being written/created.
Sadly the only solution i found was to run the script with
c:windowssystem32wscript.exe «c:{path to script}» //B
preventing the errornotice.

I have found no way to check if the file is currently being modified except for try and error.

See More Windows Update Error Codes 8004 Series

• Error 800A101A8 Object Required   •Error 800A0046   •Error 800A10AD   •Error 800A000D

• Error 80048820   •Error 800A0401   •Review of SolarWinds Permissions Monitor

• Error 80040E14   • Error 800A03EA   • Error 800A0408   • Error 800A03EE

Solarwinds Free WMI MonitorGuy Recommends: WMI Monitor and It’s Free!

Windows Management Instrumentation (WMI) is one of the hidden treasures of Microsoft operating systems.  Fortunately, SolarWinds have created the WMI Monitor so that you can examine these gems of performance information for free.  Take the guess work out of which WMI counters to use for applications like Microsoft Active Directory, SQL or Exchange Server.

Download your free copy of WMI Monitor


Do you need additional help?

  • For interpreting the WSH messages check Diagnose 800 errors.
  • For general advice try my 7 Troubleshooting techniques.
  • See master list of 0800 errors.
  • Codes beginning 08004…
  • Codes beginning 08005…
  • Codes beginning 08007…
  • Codes beginning 0800A…

Give something back?

Would you like to help others?  If you have a good example of this error, then please email me, I will publish it with a credit to you:

If you like this page then please share it with your friends


Перейти к содержимому раздела

Серый форум

разработка скриптов

Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.

VBS: Ошибка «Разрешение отклонено»

Страницы 1

Чтобы отправить ответ, вы должны войти или зарегистрироваться

1 2014-08-21 21:32:32 (изменено: sprohorenok, 2014-08-22 18:53:07)

  • sprohorenok
  • Участник
  • Неактивен
  • Рейтинг : [0|0]

Тема: VBS: Ошибка «Разрешение отклонено»

Приветствую всех скриптологов)

Столкнулся со следующей проблемой:
В логон-скрипте, помещенном в  «Конфигурация компьютера…Сценарии (запуск/завершение)» (GroupPolice) использую механизм вставки в тело скрипта данных из другого скрипта. Вот кусок кода:

Private Sub IncludeFileAbs (ByVal FileName)
   Const ForReading = 1
   Dim f: set f = fso.OpenTextFile(FileName,ForReading)
   Dim s: s = f.ReadAll()
   ExecuteGlobal s
   End Sub

Файл находится на общем ресурсе.
Так вот, при попытке открыть файл происходит ошибка «Разрешение отклонено».
Что пытался делать:
Добавил разрешение ntfs до полных прав на каталог, где находится FileName, для учетной записи компьютера (CompName$) — результат тот же.

Вопрос, под какой учетной записью компьютер обращается к расшаренному ресурсу, как побороть данную ошибку?

2 Ответ от alexii 2014-08-22 16:07:14

  • alexii
  • Разработчик
  • Неактивен

Re: VBS: Ошибка «Разрешение отклонено»

В логон-скрипте, помещенном в конфигурацию компьютера — сценарий при входе (GroupPolice)

Нет такого. Есть «Конфигурация компьютера…Сценарии (запуск/завершение)» и есть «Конфигурация пользователя…Вход/выход из системы». А такого, как написали Вы, не существует.

Вопрос, под какой учетной записью компьютер обращается к расшаренному ресурсу, как побороть данную ошибку?

Скорректируйте ранее упомянутую мною неточность в формулировке.

3 Ответ от sprohorenok 2014-08-22 18:56:47

  • sprohorenok
  • Участник
  • Неактивен
  • Рейтинг : [0|0]

Re: VBS: Ошибка «Разрешение отклонено»

alexii пишет:

Скорректируйте ранее упомянутую мною неточность в формулировке.

Совершенно верное замечание, писал на память, уже исправил.

4 Ответ от sprohorenok 2014-08-30 21:38:43

  • sprohorenok
  • Участник
  • Неактивен
  • Рейтинг : [0|0]

Re: VBS: Ошибка «Разрешение отклонено»

Решение найдено. Помогла статья.

Читая http://support.microsoft.com/kb/303650/ru обратил внимание на следующее:

****

Такая ситуация может возникнуть, если FQDN или IP-адрес содержит точки. При наличии точки в FQDN или IP-адресе Internet Explorer распознает веб-узел как зону Интернета.

******

Заменил форму обращения к сетевому ресурсу с «\IP-адрессетевой ресурс» на «\имя ПКсетевой ресурс» все заработало.

Сообщения 4

Страницы 1

Чтобы отправить ответ, вы должны войти или зарегистрироваться

  • Remove From My Forums
  • Question

  • Hi All,

    i tried move a folder YYYYmm format using below VBScript, move to destination same folder directory, YYYYyyyyMM. However, command prompt shown me Permission Denied, Error Code: 800A0046.

    server Date time format: mm/DD/yyyy, i use VBscript to twist to format DD/MM/yyyy to match folder.

    CDATE(currDay+ «/»  + currMonth + «/» + CurrYYYY)

    'How to use:
    ' type "archiver D:root source folder" in command line eg: D:Testarchiverarchiver.vbs "D:Testarchiver"
    
    DIM strLogFile
    Const ForAppending = 8
    'Wscript.StdOut.WriteBlanklines 100
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    strLogFile=WScript.Arguments(0) &"LogARCHIVER_Log_" & Year(Date) & Month(Date) & Day(Date) & ".txt"
    
    'Log folder not exists then create new folder
    IF NOT FSO.FolderExists(WScript.Arguments(0) &"Log") THEN
    		FSO.CreateFolder WScript.Arguments(0) & "Log"
    END IF
    
    Set objLogFile = FSO.OpenTextFile(strLogFile, ForAppending, True)
    
    objLogfile.WriteLine NOW & ">> ------------ ARCHIVER BEGIN ------------------"
    objLogfile.WriteLine ""
    objLogfile.WriteLine Now & ">> Root Folder: " & WScript.Arguments(0)
    objLogfile.WriteLine ""
    archiver(FSO.GetFolder(WScript.Arguments(0)))
    objLogfile.WriteLine NOW & ">> ------------ ARCHIVER END ------------------"
    objLogfile.WriteLine ""
    objLogFile.Close 
    
    
    Sub archiver(Folder)
    
    	DIM year_
    	DIM month_
    	Dim dt
    	dt=now
    	
    	'output format: yyyymmddHHnn
    	currMonth=Cstr(month(dt)) 	'current Month
    	currDay=Cstr(day(dt)) 		'current day
    	CurrYYYY=Cstr(year(dt)) 	'current Year
    	'wscript.echo currMonth
    	'wscript.echo currDay
    	'wscript.echo CurrYYYY	
    	
    	archiveMonth = -6
    	'Set myLog = objFSO.OpenTextFile(destinationPath, For_Writing, True)
            For Each Subfolder in Folder.SubFolders		
    		IF LEN(subfolder.Name) = 8 AND ISNUMERIC(subfolder.Name) THEN
    			year_ = MID(subfolder.Name,1,4)
    			month_ = MID(subfolder.Name,5,2)
    			
    
    			objLogfile.WriteLine "Process Checking MM-DD-YY Now......"
    			'objLogfile.WriteLine FormatDateTime(CDATE("01/" + month + "/" + year),2)
    			'IF IsDate(CDATE("01/" + month + "/" + year)) AND DateDiff("m", Date, "01/" + month + "/" + year) < archiveMonth  THEN
    			IF IsDate(CDATE("01/" + month_ + "/" + year_)) AND DateDiff("m", CDATE(currDay+ "/"  + currMonth + "/" + CurrYYYY), "01/" + month_ + "/" + year_) <= archiveMonth  THEN
    			
    				objLogfile.WriteLine archiveMonth '-6
    				objLogfile.WriteLine IsDate(CDATE("01/" + month_ + "/" + year_)) 'True
    				
    				objLogfile.WriteLine NOW & ">> Processing >> " + Subfolder.Name
    				destinationPath = year_ 'WScript.Arguments(0) + " " + year
    				'Year folder not exists then create new folder
    				IF NOT FSO.FolderExists(destinationPath) THEN
    					FSO.CreateFolder destinationPath
    					
    				END IF
    		
    				IF FSO.FolderExists(destinationPath) THEN
    					destinationPath = destinationPath + "" + year_ + month_
    					IF FSO.FolderExists(destinationPath) THEN
    						objLogfile.WriteLine NOW & ">> Moving folder " + Subfolder.Name + " to destination: " + destinationPath
    						Subfolder.Move destinationPath + "" + Subfolder.Name
    					ELSE
    						'Year + Month folder not exists then create new folder
    						FSO.CreateFolder destinationPath
    						IF FSO.FolderExists(destinationPath) THEN
    							objLogfile.WriteLine NOW & ">> Moving folder " + Subfolder.Name + " to destination: " + destinationPath
    							Subfolder.Move destinationPath + "" + Subfolder.Name
    						ELSE
    							objLogfile.WriteLine NOW & ">> ** ERROR: Unable to create folder: " + destinationPath	
    						END IF
    					END IF
    				ELSE
    					objLogfile.WriteLine NOW & ">> ** ERROR: Unable to create folder: " + destinationPath
    				END IF
    				'Wscript.StdOut.WriteBlanklines 1
    				'objLogfile.WriteLine ""
    
    			END IF
    		END IF
            Next
    End Sub

    Error Message

    Script: D:….Archivedarchiver.vbs

    Line: 71

    Char: 7

    Error Code: Permission Denied

    Code: 800A0046

    Source Code: Microsoft VBScript runtime error

    • Moved by

      Wednesday, January 2, 2019 3:18 PM
      This is not «fix/debug/rewrite my script for me» forum

  • Remove From My Forums
  • Question

  • Hi All,

    i tried move a folder YYYYmm format using below VBScript, move to destination same folder directory, YYYYyyyyMM. However, command prompt shown me Permission Denied, Error Code: 800A0046.

    server Date time format: mm/DD/yyyy, i use VBscript to twist to format DD/MM/yyyy to match folder.

    CDATE(currDay+ «/»  + currMonth + «/» + CurrYYYY)

    'How to use:
    ' type "archiver D:root source folder" in command line eg: D:Testarchiverarchiver.vbs "D:Testarchiver"
    
    DIM strLogFile
    Const ForAppending = 8
    'Wscript.StdOut.WriteBlanklines 100
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    strLogFile=WScript.Arguments(0) &"LogARCHIVER_Log_" & Year(Date) & Month(Date) & Day(Date) & ".txt"
    
    'Log folder not exists then create new folder
    IF NOT FSO.FolderExists(WScript.Arguments(0) &"Log") THEN
    		FSO.CreateFolder WScript.Arguments(0) & "Log"
    END IF
    
    Set objLogFile = FSO.OpenTextFile(strLogFile, ForAppending, True)
    
    objLogfile.WriteLine NOW & ">> ------------ ARCHIVER BEGIN ------------------"
    objLogfile.WriteLine ""
    objLogfile.WriteLine Now & ">> Root Folder: " & WScript.Arguments(0)
    objLogfile.WriteLine ""
    archiver(FSO.GetFolder(WScript.Arguments(0)))
    objLogfile.WriteLine NOW & ">> ------------ ARCHIVER END ------------------"
    objLogfile.WriteLine ""
    objLogFile.Close 
    
    
    Sub archiver(Folder)
    
    	DIM year_
    	DIM month_
    	Dim dt
    	dt=now
    	
    	'output format: yyyymmddHHnn
    	currMonth=Cstr(month(dt)) 	'current Month
    	currDay=Cstr(day(dt)) 		'current day
    	CurrYYYY=Cstr(year(dt)) 	'current Year
    	'wscript.echo currMonth
    	'wscript.echo currDay
    	'wscript.echo CurrYYYY	
    	
    	archiveMonth = -6
    	'Set myLog = objFSO.OpenTextFile(destinationPath, For_Writing, True)
            For Each Subfolder in Folder.SubFolders		
    		IF LEN(subfolder.Name) = 8 AND ISNUMERIC(subfolder.Name) THEN
    			year_ = MID(subfolder.Name,1,4)
    			month_ = MID(subfolder.Name,5,2)
    			
    
    			objLogfile.WriteLine "Process Checking MM-DD-YY Now......"
    			'objLogfile.WriteLine FormatDateTime(CDATE("01/" + month + "/" + year),2)
    			'IF IsDate(CDATE("01/" + month + "/" + year)) AND DateDiff("m", Date, "01/" + month + "/" + year) < archiveMonth  THEN
    			IF IsDate(CDATE("01/" + month_ + "/" + year_)) AND DateDiff("m", CDATE(currDay+ "/"  + currMonth + "/" + CurrYYYY), "01/" + month_ + "/" + year_) <= archiveMonth  THEN
    			
    				objLogfile.WriteLine archiveMonth '-6
    				objLogfile.WriteLine IsDate(CDATE("01/" + month_ + "/" + year_)) 'True
    				
    				objLogfile.WriteLine NOW & ">> Processing >> " + Subfolder.Name
    				destinationPath = year_ 'WScript.Arguments(0) + " " + year
    				'Year folder not exists then create new folder
    				IF NOT FSO.FolderExists(destinationPath) THEN
    					FSO.CreateFolder destinationPath
    					
    				END IF
    		
    				IF FSO.FolderExists(destinationPath) THEN
    					destinationPath = destinationPath + "" + year_ + month_
    					IF FSO.FolderExists(destinationPath) THEN
    						objLogfile.WriteLine NOW & ">> Moving folder " + Subfolder.Name + " to destination: " + destinationPath
    						Subfolder.Move destinationPath + "" + Subfolder.Name
    					ELSE
    						'Year + Month folder not exists then create new folder
    						FSO.CreateFolder destinationPath
    						IF FSO.FolderExists(destinationPath) THEN
    							objLogfile.WriteLine NOW & ">> Moving folder " + Subfolder.Name + " to destination: " + destinationPath
    							Subfolder.Move destinationPath + "" + Subfolder.Name
    						ELSE
    							objLogfile.WriteLine NOW & ">> ** ERROR: Unable to create folder: " + destinationPath	
    						END IF
    					END IF
    				ELSE
    					objLogfile.WriteLine NOW & ">> ** ERROR: Unable to create folder: " + destinationPath
    				END IF
    				'Wscript.StdOut.WriteBlanklines 1
    				'objLogfile.WriteLine ""
    
    			END IF
    		END IF
            Next
    End Sub

    Error Message

    Script: D:….Archivedarchiver.vbs

    Line: 71

    Char: 7

    Error Code: Permission Denied

    Code: 800A0046

    Source Code: Microsoft VBScript runtime error

    • Moved by

      Wednesday, January 2, 2019 3:18 PM
      This is not «fix/debug/rewrite my script for me» forum

0 0 голоса
Рейтинг статьи
Подписаться
Уведомить о
guest

0 комментариев
Старые
Новые Популярные
Межтекстовые Отзывы
Посмотреть все комментарии

А вот еще интересные материалы:

  • Яшка сломя голову остановился исправьте ошибки
  • Ясность цели позволяет целеустремленно добиваться намеченного исправьте ошибки
  • Ясность цели позволяет целеустремленно добиваться намеченного где ошибка
  • Ошибка вызова функции параметр идентификатор пакета должен содержать guid
  • Ошибка выполнения opc при записи диска