Класс не поддерживает автоматизацию или не поддерживает ожидаемый интерфейс

Question

Класс не поддерживает автоматизацию или не поддерживает ожидаемый интерфейс

Я импортирую своего рода файл безопасности CSV для отчетов в Excel. Файл в основном имеет следующий формат:

!Users
UserA
UserB
UserC
...

!Roles
RoleA
RoleB
RoleC
...

!Permissions
UserA|RoleA
UserA|RoleB
UserC|RoleA
UserB|RoleC
...

Отчет - это своего рода матрица, которая будет выглядеть так:

  | A            | B            | C            | D
--|--------------|--------------|--------------|----------------
1 |              | RoleA        | RoleB        | RoleC
2 | UserA        | Y            | Y            | N
3 | UserB        | N            | N            | Y
4 | UserC        | Y            | N            | N

Самый простой способ сделать это - выполнить следующие шаги:

Откройте файл и поместите все в 3 многоуровневых словаря (один для пользователей, один для ролей и один для разрешений), используя Scripting.Dictionary,
Создайте лист и постройте матрицу на основе словарей.

Очевидно, что фактический формат файла и его реализация несколько сложнее, но это суть.

Он отлично работает для файлов размером до 10 МБ, но когда файлы начинают превышать это число (тысячи пользователей и ролей), я получаю следующую ошибку:

Run-time error '430':

Class does not support Automation or does not support expected interface

Это происходит в следующей строке:

Set pubSecClassAccess.Item(vClass).Item(vValue).Item(vUser) = New Scripting.Dictionary

Если я смотрю под процессами, EXCEL.EXE использует около 1,5 ГБ оперативной памяти в тот момент, когда выдает ошибку. Если я заканчиваю, а не отлаживаю, а затем закрываю книгу, я получаю следующее сообщение:

Excel cannot complete this task with available resources. Choose less data or close other applications.

Я предполагаю, что у меня заканчивается ОЗУ, хотя у меня все еще есть около 4 ГБ из 8 ГБ доступных.

Мой вопрос: как мне перефакторинг моего кода, чтобы он делал это без использования большого количества оперативной памяти?

Разделы в файле могут быть в другом порядке (например, !Permissions может прийти раньше !Users раздел).

0

excel vba excel-vba runtime-error scripting.dictionary

Источник

user1877903 21 окт '14 в 13:38

1 ответ

Решение

Другие вопросы по тегам excel vba excel-vba runtime-error scripting.dictionary

user973283 23 окт '14 в 10:19 2014-10-23 10:19 · Accepted Answer · 2014-10-23 10:19

Изменить Забыл сказать: макрос занимает около одной минуты, чтобы обработать мой тестовый файл 55 Мб.

Я не могу найти ничего о требованиях к памяти словарей. Тем не менее, так как "Это выдает ошибку, прежде чем я сделаю сортировку", никакие незначительные улучшения в том, как обрабатываются словари, не помогут. Моя техника совершенно другая.

Сначала я создал тестовый файл со следующими характеристиками:

50000 пользователей
200 ролей
имена пользователей и ролей длиной от 15 до 25 символов
от 0 до 50 разрешений на пользователя

Результирующий файл размером около 55 МБ содержит более миллиона разрешений. Я не собирался создавать такой большой файл, но не задумывался о значении 25 разрешений на пользователя. Я должен признать, что файл содержит дубликаты разрешений. Макрос ниже учитывает эту ошибку и пропускает дубликаты.

Мой код имеет несколько шагов:

Удалите все файлы, созданные при предыдущем запуске макроса.
Прочитайте тестовый файл (журнал безопасности) и выведите три отдельных файла: User.txt, Roles.txt и Perms.txt. Я только что заметил последнюю строку вашего вопроса, в которой вы говорите, что разделы не в фиксированной последовательности. Если вам нравится остальная часть моего кода, это было бы легко исправить.
Создайте пакетные файлы для сортировки User.txt, Roles.txt и Perms.txt.
Используйте Shell для запуска этих командных файлов.
Цикл пока все пакетные файлы не будут завершены.
Считайте SortedUsers.txt и SortedRoles.txt в массивы. Именно эти массивы будут ограничивать размер обрабатываемого журнала безопасности. Я подсчитал строки при создании отдельных файлов, чтобы эти массивы были точно подходящего размера без лишних затрат. Если вам снова не хватит памяти, SortedUsers.txt может быть прочитан построчно.
Считайте соответствие SortedPerms.txt с массивами и выведите строки, созданные в Report.txt.

Я могу открыть Report.txt (который 21Mb) с Excel и привести в порядок форматирование.

Ниже приведены два модуля. Первый содержит макрос, описанный выше. Второй содержит подпрограмму проверки, которую я использую, когда процессы завершены.

Option Explicit
Sub CreateReport()

  Dim FileName As Variant
  Dim FlIn As Object
  Dim FlLine As String
  Dim FlLinePart() As String
  Dim FlOut As Object
  Dim FlSysObj As Object
  Dim Found As Boolean
  Dim InxProc As Long
  Dim NumPermissions As Long
  Dim NumRoles As Long
  Dim NumUsers As Long
  Dim PathCrnt As String
  Dim Process() As String
  Dim Roles() As String
  Dim RoleCrnt As Long
  Dim RoleNameLast As String
  Dim TimeNow As Double
  Dim Users() As String
  Dim UserCrnt As Long
  Dim UserNameLast As String

  Dim StartTime As Double

  StartTime = Timer

  ' I find it convenient to have all files in the same folder as the workbook
  ' Change PathCrnt as required
  PathCrnt = ActiveWorkbook.Path & "\"

  ' Delete any files left by previous run of macro
  ' Replace Report.txt by your name for output file
  ' =====================================================================================
  For Each FileName In Array("Users.txt", "Roles.txt", "Perms.txt", _
                             "SortedUsers.txt", "SortedRoles.txt", "SortedPerms.txt", _
                             "SortUsers.bat", "SortRoles.bat", "SortPerms.bat", _
                             "Report.txt")
    If Dir$(PathCrnt & FileName) <> "" Then
      Kill PathCrnt & FileName
    End If
  Next

  ' Split security log into three separate files: Users.txt, Roles.txt and Perms.txt
  ' =====================================================================================

  Set FlSysObj = CreateObject("Scripting.FileSystemObject")

  Set FlIn = FlSysObj.OpenTextFile(PathCrnt & "testfile.txt", 1, False, 0)

  FlLine = FlIn.ReadLine
  Debug.Assert FlLine = "!Users"
  NumUsers = 0
  Set FlOut = FlSysObj.OpenTextFile(PathCrnt & "Users.txt", 2, True, 0)

  Do While Not FlIn.AtEndOfStream
    FlLine = FlIn.ReadLine
    If FlLine <> "" Then
      If FlLine = "!Roles" Then
        Exit Do
      End If
      NumUsers = NumUsers + 1
      FlOut.WriteLine FlLine
    End If
  Loop
  FlOut.Close

  Debug.Assert FlLine = "!Roles"
  NumRoles = 0
  Set FlOut = FlSysObj.OpenTextFile(PathCrnt & "Roles.txt", 2, True, 0)

  Do While Not FlIn.AtEndOfStream
    FlLine = FlIn.ReadLine
    If FlLine <> "" Then
      If FlLine = "!Permissions" Then
        Exit Do
      End If
      NumRoles = NumRoles + 1
      FlOut.WriteLine FlLine
    End If
  Loop
  FlOut.Close

  Debug.Assert FlLine = "!Permissions"
  NumPermissions = 0
  Set FlOut = FlSysObj.OpenTextFile(PathCrnt & "Perms.txt", 2, True, 0)

  Do While Not FlIn.AtEndOfStream
    FlLine = FlIn.ReadLine
    If FlLine <> "" Then
      NumPermissions = NumPermissions + 1
      FlOut.WriteLine FlLine
    End If
  Loop
  FlOut.Close
  FlIn.Close

  ' Create batch files to sort Users.txt, Roles.txt and Perms.txt
  ' I have successfully used Shell with command line parameters but not tonight
  ' Decided not to waste time investigating my error
  ' ===============================================================================================

  Set FlOut = FlSysObj.OpenTextFile(PathCrnt & "SortUsers.bat", 2, True, 0)
  FlOut.Write "Sort <""" & PathCrnt & "Users.txt"" >""" & PathCrnt & "SortedUsers.txt"""
  FlOut.Close
  Set FlOut = FlSysObj.OpenTextFile(PathCrnt & "SortRoles.bat", 2, True, 0)
  FlOut.Write "Sort <""" & PathCrnt & "Roles.txt"" >""" & PathCrnt & "SortedRoles.txt"""
  FlOut.Close
  Set FlOut = FlSysObj.OpenTextFile(PathCrnt & "SortPerms.bat", 2, True, 0)
  FlOut.Write "Sort <""" & PathCrnt & "Perms.txt"" >""" & PathCrnt & "SortedPerms.txt"""
  FlOut.Close

  ' Sort Users.txt, Roles.txt and Perms.txt to create sorted versions
  ' ===============================================================================================

  Call Shell(PathCrnt & "SortUsers.bat")
  Call Shell(PathCrnt & "SortRoles.bat")
  Call Shell(PathCrnt & "SortPerms.bat")

  ' Loop until all the btach files have been completed
  ' ===============================================================================================

  Do While True
    Found = False
    Call GetProcessList(Process)
    For InxProc = 1 To UBound(Process)
      If Process(InxProc) = "cmd.exe" Then
        Found = True
        Exit For
      End If
    Next
    If Not Found Then
      Exit Do
    End If
    TimeNow = Now()
    ' Wait 1 second
    Application.Wait TimeSerial(Hour(TimeNow), Minute(TimeNow), Second(TimeNow) + 1)
  Loop

  ' Read SortedUsers.txt and SortedRoles.txt into arrays
  ' ===============================================================================================

  Set FlIn = FlSysObj.OpenTextFile(PathCrnt & "SortedUsers.txt", 1, False, 0)
  ReDim Users(1 To NumUsers)
  For UserCrnt = 1 To NumUsers
    Users(UserCrnt) = FlIn.ReadLine
  Next
  FlIn.Close
  Set FlIn = FlSysObj.OpenTextFile(PathCrnt & "SortedRoles.txt", 1, False, 0)
  ReDim Roles(1 To NumRoles)
  For RoleCrnt = 1 To NumRoles
    Roles(RoleCrnt) = FlIn.ReadLine
  Next
  FlIn.Close

  ' Read SortedPerms.txt and generate Report.txt
  ' ===============================================================================================

  Set FlIn = FlSysObj.OpenTextFile(PathCrnt & "SortedPerms.txt", 1, False, 0)

  ' Replace Report.txt" with your name for the output file
  Set FlOut = FlSysObj.OpenTextFile(PathCrnt & "Report.txt", 2, True, 0)

  ' Create and output header row
  FlLine = """User"""
  For RoleCrnt = 1 To NumRoles
    FlLine = FlLine & ",""" & Roles(RoleCrnt) & """"
  Next
  FlOut.WriteLine FlLine

  UserCrnt = 0
  RoleCrnt = 0
  UserNameLast = ""
  RoleNameLast = ""
  FlLine = ""

  ' Output header row within do loop

  Do While Not FlIn.AtEndOfStream
    FlLinePart = Split(FlIn.ReadLine, "|")
    Debug.Assert UBound(FlLinePart) = 1
    If FlLinePart(0) = UserNameLast And FlLinePart(1) = RoleNameLast Then
      ' My test file contains some duplicate permissions
    Else
      ' Process good permission
      If FlLinePart(0) <> UserNameLast Then
        ' New user or first permission
        If FlLine <> "" Then
          ' Output line for last user
          If RoleCrnt = NumRoles Then
            ' Last role already output
          Else
            ' Add Ns for remaining roles
            FlLine = FlLine & Replace(String(NumRoles - RoleCrnt, "N"), "N", ",N")
          End If
          FlOut.WriteLine FlLine
        End If
        UserCrnt = UserCrnt + 1
        FlLine = Users(UserCrnt)       ' Initialise line for new user
        RoleCrnt = 0
      End If
      Do While FlLinePart(0) > Users(UserCrnt)
        ' This user has no permissions. Output line of Ns for it
        FlLine = FlLine & Replace(String(NumRoles, "N"), "N", ",N")
        FlOut.WriteLine FlLine
        UserCrnt = UserCrnt + 1
        FlLine = Users(UserCrnt)
      Loop
      If FlLinePart(0) < Users(UserCrnt) Then
        Debug.Assert False
        ' User for this permission does not appear in user list
        ' Assume this should not be possible.
        ' Output error message if it does
      Else
        ' Have permission for current user
        ' Find entry in Roles() for permiisoin's role
        Do While True
          RoleCrnt = RoleCrnt + 1
          If FlLinePart(1) > Roles(RoleCrnt) Then
            ' This user does not have this current role
            FlLine = FlLine & ",N"
          ElseIf FlLinePart(1) < Roles(RoleCrnt) Then
            Debug.Assert False
            ' Role for this permission does not appear in role list
            ' Assume this should not be possible.
            ' Output error message if it does
          Else
            ' This user has this permission
            FlLine = FlLine & ",Y"
            Exit Do
          End If
        Loop
      End If
    End If
    UserNameLast = FlLinePart(0)
    RoleNameLast = FlLinePart(1)
  Loop  ' For each permission
            ' Add Ns for remaining roles
  FlLine = FlLine & Replace(String(NumRoles - RoleCrnt, "N"), "N", ",N")
  FlOut.WriteLine FlLine        ' Output final line

  FlOut.Close

  Debug.Print Format(Timer - StartTime, "#,##0.0")

End Sub

,

Option Explicit
  ' Source http://vbadud.blogspot.co.uk/2007/06/show-all-processes-using-vba.html
  ' Modified by Tony Dallimore

  Const TH32CS_SNAPHEAPLIST = &H1
  Const TH32CS_SNAPPROCESS = &H2
  Const TH32CS_SNAPTHREAD = &H4
  Const TH32CS_SNAPMODULE = &H8
  Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or _
                          TH32CS_SNAPPROCESS Or _
                          TH32CS_SNAPTHREAD Or _
                          TH32CS_SNAPMODULE)
  Const TH32CS_INHERIT = &H80000000
  Const MAX_PATH As Integer = 260

  Private Type PROCESSENTRY32
    dwSize As Long
    cntUsage As Long
    th32ProcessID As Long
    th32DefaultHeapID As Long
    th32ModuleID As Long
    cntThreads As Long
    th32ParentProcessID As Long
    pcPriClassBase As Long
    dwFlags As Long
    szExeFile As String * MAX_PATH
  End Type

  Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" _
                      (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
  Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)

  ' API Functions to get the processes
  Private Declare Function Process32First Lib "kernel32" _
                      (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
  Private Declare Function Process32Next Lib "kernel32" _
                      (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Public Sub GetProcessList(Process() As String)

  Dim hSnapShot As Long          '* Handle
  Dim uProcess As PROCESSENTRY32 '* Process
  Dim lRet                       '* Return Val

  Dim InxP As Long
  Dim Pos As Long

  ReDim Process(1 To 100)
  InxP = 0      ' Array is empty

'  On Error Resume Next

  ' Takes a snapshot of the running processes and the heaps, modules,
  ' and threads used by the processes

  hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)

  uProcess.dwSize = Len(uProcess)

  ' Retrieve information about the first process encountered in our system snapshot

  ' uProcess.szExeFile is a fixed length string of 260 characters.  Each new process
  ' name is terminated with &H0 and overwrites the previous name.  Hence the need to
  ' discard the first &H0 and any characters that follow.

  ' In the original code, the first process name was ignored.  During my
  ' experimentation, the first name was always "[System Process]" which appears to be
  ' a header.  I continue to discard the first process name

  ' In the original code, the final lRet was output before being tested to be true.
  ' This meant the last name was junk.  I always test lRet before extracting the name.

  lRet = Process32First(hSnapShot, uProcess)  ' Ignore "[System]"
  lRet = Process32Next(hSnapShot, uProcess)
  ' lRet is 0 or 1.  1 means uProcess has been loaded with another process.

  Do While lRet

    InxP = InxP + 1
    If InxP > UBound(Process) Then
      ReDim Preserve Process(1 To UBound(Process) + 100)
    End If

    Pos = InStr(1, uProcess.szExeFile, Chr$(0))
    If Pos > 0 Then
      Pos = Pos - 1
    Else
      Pos = 0
    End If
    Process(InxP) = Left$(uProcess.szExeFile, Pos)

    lRet = Process32Next(hSnapShot, uProcess)

  Loop

  CloseHandle hSnapShot

  ' This ReDim assumes there is at least one process.
  ReDim Preserve Process(1 To InxP)  ' Discard empty entries

End Sub