vbscript权限被拒绝800a0046网络

时间:2015-04-24 12:11:05

标签: vba email vbscript outlook

我制作了一个将文件复制到某个位置的脚本。 我将.vbs添加到计划进行.pst备份的taskschd.msc中 但我收到错误消息

行:91 查尔:7 错误:权限被拒绝 代码:800A0046 来源:Microsoft VBScript运行时错误

<pre>



'Set the amount of pst-files you want to copy. Start counting at 0!
ReDim pst(1)

'Define the location of each pst-file to backup. Increase the counter!
pst(0) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de@teknotrans.se.pst"
pst(1) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de.pst"

'Define your backup location
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"

'Keep old backups? TRUE/FALSE
KeepHistory = FALSE

'Maximum time in milliseconds for Outlook to close on its own
delay = 30000 'It is not recommended to set this below 8000

'Start Outlook again afterwards? TRUE/FALSE
start = TRUE

'===================STOP MODIFY====================================

'Close Outlook
Call CloseOutlook(delay)

'Outlook is closed, so we can start the backup
Call BackupPST(pst, BackupPath, KeepHistory)

'Open Outlook again when desired.
If start = TRUE Then
  Call OpenOutlook()
End If


Sub CloseOutlook(delay)
  strComputer = "."
  Set objWMIService = GetObject("winmgmts:" _
  & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

  'If Outlook is running, let it quit on its own.
  For Each Process in objWMIService.InstancesOf("Win32_Process")
    If StrComp(Process.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
      Set objOutlook = CreateObject("Outlook.Application")
      objOutlook.Quit
      WScript.Sleep delay
      Exit For
    End If
  Next

  'Make sure Outlook is closed and otherwise force it.
  Set colProcessList = objWMIService.ExecQuery _
  ("Select * from Win32_Process Where Name = 'Outlook.exe'")
  For Each objProcess in colProcessList
    objProcess.Terminate()
  Next
  Set objWMIService = Nothing
  Set objOutlook = Nothing
  set colProcessList = Nothing
End Sub


Sub BackupPST(pst, BackupPath, KeepHistory)
  Set fso = CreateObject("Scripting.FileSystemObject")

  If KeepHistory = True Then
    ArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
    BackupPath = BackupPath & ArchiveFolder & "\"
  End If

  If fso.FolderExists(BackupPath) = False Then
    fso.CreateFolder BackupPath
  End If

  For Each pstPath in pst
    If fso.FileExists(pstPath) Then
      fso.CopyFile pstPath, BackupPath, True
    End If
  Next
  Set fso = Nothing
End Sub


Sub OpenOutlook()
  Set objShell = CreateObject("WScript.Shell")
  objShell.Run "Outlook.exe"
End Sub


</pre>

有人可以帮我解决这个问题吗?

提前谢谢

2 个答案:

答案 0 :(得分:0)

已编辑:更改文件夹的权限。

  1. 在Windows资源管理器中,导航到PST文件所在的文件夹。
  2. 在Windows资源管理器的左侧窗格中,右键单击PST文件所在的文件夹,选择“属性”。
  3. 选择“安全”标签
  4. 点击“编辑”按钮更改权限。
  5. 点击“添加”
  6. 在要选择的对象名称框中,输入“everyone”(无引号)。
  7. 点击“检查姓名”,每个人都应该大写并加下划线。
  8. 点击“确定”
  9. 从组或用户名列表中选择“所有人”。
  10. 在“每个人的权限”列表中,确保选中“读取和执行,列出文件夹内容和读取,在允许列中”,然后单击“应用”
  11. 点击确定。
  12. 注意:通过这样做,有权访问此计算机的任何人都可以访问该文件夹。您可能只考虑将登录计算机添加到组或用户名列表而不是Everyone。您可能需要在相关的PST文件上重复上述步骤。

    原帖:

    我在这里运行脚本,测试各种问题并且运行没有问题。此时我认为问题是源文件夹或目标文件夹(或您要备份的文件)的权限和权限。默认情况下,用户自己无权访问Outlook数据文件。您需要为相关文件(PST,OST等)或完整文件夹添加“读取”权限。   实际上,仅备份PST文件不足以恢复Outlook配置;你需要所有的文件。 你可以试试这个:

    '===================================================================
    'Description: VBS script to backup your pst-files.
    '
    'Comment: Before executing the vbs-file, set the location of outlook
    '         folder you want to backup and
    '         the backup location (this can also be a network path).
    '         See the URL below for more configuration instructions and
    '         how to create a Scheduled Task for it.
    '
    ' Original author : Robert Sparnaaij
    ' Modified:  Fred Kerber
    ' version: 1.1
    ' website: http://www.howto-outlook.com/downloads/backupscript.htm
    ' Changes:
    '   Changed var types; changed to backup full folder and not just pst files.
    '===================================================================
    '===================BEGIN MODIFY====================================
    
    
    
    'Define the folder location of Outlook's data files.
    sOutlookDataPath = "C:\Users\FKerber.CORP\AppData\Local\Microsoft\Outlook\"
    
    'Define your backup location
    sBackupPath = "E:\Outlook Backup\"
    
    'Keep old backups? TRUE/FALSE
    bKeepHistory = TRUE
    
    'Maximum time in milliseconds for Outlook to close on its own
    iDelay = 30000 'It is not recommended to set this below 8000
    
    'Start Outlook again afterwards? TRUE/FALSE
    bStart = True
    
    '===================STOP MODIFY====================================
    'Close Outlook
    Call CloseOutlook(iDelay)
    
    'Outlook is closed, so we can start the backup
    Call BackupOutlook(sOutlookDataPath, sBackupPath, bKeepHistory)
    
    'Open Outlook again when desired.
    If bStart = TRUE Then
      Call OpenOutlook()
    End If
    
    Sub CloseOutlook(iDelay)
      Set objWMIService = GetObject("winmgmts:" &_
       {impersonationLevel= impersonate}!\\.\root\cimv2")
    
      'If Outlook is running, let it quit on its own.
       For Each oProcess in objWMIService.InstancesOf("Win32_Process")
         If StrComp(oProcess.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
           Set objOutlook = CreateObject("Outlook.Application")
           objOutlook.Quit
           WScript.Sleep delay
           Exit For
         End If
       Next
    
      'Make sure Outlook is closed and otherwise force it.
      Set colProcessList = objWMIService.ExecQuery _
      ("Select * from Win32_Process Where Name = 'Outlook.exe'")
      For Each objProcess in colProcessList
        objProcess.Terminate()
      Next
      Set objWMIService = Nothing
      Set objOutlook = Nothing
      Set colProcessList = Nothing
    End Sub
    
    Sub BackupOutlook(sOutlook, sBackupPath, bKeepHistory)
      Set ofso = CreateObject("Scripting.FileSystemObject")
    
      If bKeepHistory = True Then
        sArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
        sBackupPath = sBackupPath & sArchiveFolder & "\"
      Else
        For Each oFile In ofso.GetFolder(sBackupPath).Files
          ofso.DeleteFile oFile.Path, True
        Next
      End If
    
      If ofso.FolderExists(sBackupPath) = False Then
        ofso.CreateFolder sBackupPath
      End If
    
      For Each oFile In ofso.GetFolder(sOutlook).Files
        If ofso.FileExists(oFile.Path) Then
          ofso.CopyFile oFile.Path, sBackupPath, True
        End If
      Next
      Set ofso = Nothing
    End Sub
    
    Sub OpenOutlook()
      Set objShell = CreateObject("WScript.Shell")
      objShell.Run "Outlook.exe"
    End Sub
    

答案 1 :(得分:0)

好像你安排了脚本。 您需要使用执行具有PST文件权限的脚本的用户以及存储备份的路径来启动任务。使用系统帐户运行它是不够的。

还有更好的方法来备份PST文件,我使用Ruby脚本将本地副本与备份副本同步,在PST上运行超过10GB大而没有问题,如果你愿意,可能会出现问题用这样的副本来做。

您还需要在备份媒体上备份副本,因为当PST出现错误(以及所有大型PST都有)时,您会将错误复制到备份中,并且可能会丢失这两者。

另外,您执行以下操作

BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
...
BackupPath = BackupPath & ArchiveFolder & "\"

两个第一个变量之间的位置在哪里?