Excel VBA를 사용하여 디렉터리 내용을 검사하고 테이블을 업데이트하십시오.

Question

디렉터리의 내용을 검사하고 해당 검사 결과로 테이블을 업데이트하는 vba 스크립트를 작성했습니다. 결과는 파일이 Unchanged, New 또는 Missing이고 테이블의 File Status 열로 업데이트됩니다. 새로운 파일이면 파일 이름을 테이블의 Filename 열에 넣습니다.

코드가 상당히 비슷하지만 두 개의 배열을 통과하는 논리에 문제가 있습니다. 나는 코드에서 더 많은 문제를 일으키지 않고 이것을 보면서 내 능력을 다 써 버렸다. 더 많은 변화가 코드에서 회귀를 야기하고있다.

누구나 코드를 살펴볼 수 있습니까? 내가 올바른 길을 가고 있는지 또는 간단한 실수가 있는지 확인하십시오. 일부 파일이 누락되었거나 잘못 표시되는 것으로 잘못 표시되는 경우가 있습니다. 그러나 잘못 되었으면 먼저 변경되지 않은 파일을 올바르게 표시하고 있다고 생각합니다.

Sub FolderContents() 

Dim objFSO, objFolder, objFile As Object 
Dim g, h, i, j, k, l As Integer 
Dim myTable As ListObject 
Dim myArray As Variant 
Dim FileArray(), FileStatusArray() As String 
Dim wsName, tbName, fnName, fsName, Path As String 
Dim colNumFile, colNumStatus As Long 
Dim newRow As ListRow 
h = 1 
j = 1 
l = 1 

' Change only these values if name of table or worksheets change 
wsName = "Signage List"  'Worksheet name that contains the signage table 
tbName = "Signage"   'Table name for the signage file data 
fnName = "Filename"   'Column name that contains the file names 
fsName = "File Status"  'Column name that contains the file statuses 

' ! DO NOT EDIT ANYTHING BELOW THIS LINE ! 

Application.FileDialog(msoFileDialogFolderPicker).ButtonName = "Select Folder" 
Set objFSO = CreateObject("Scripting.FileSystemObject") 

With Application.FileDialog(msoFileDialogFolderPicker) 
    .AllowMultiSelect = False 
    .Title = "Select destination folder" 
    If .Show = -1 And .SelectedItems.Count = 1 Then 
     Path = .SelectedItems(1) 
    Else: Exit Sub 
    End If 
End With 

Set objFolder = objFSO.GetFolder(Path) 
Set myTable = Worksheets(wsName).ListObjects(tbName) 
colNumFile = myTable.ListColumns(fnName).Index 
colNumStatus = myTable.ListColumns(fsName).Index 

If Not myTable.ListColumns(colNumFile).DataBodyRange Is Nothing Then 
    myArray = myTable.ListColumns(colNumFile).DataBodyRange 
End If 

If Not IsEmpty(myArray) Then 
    For Each objFile In objFolder.Files 
     If objFile.Type = "PNG image" Then 
      For i = LBound(myArray) To UBound(myArray) 
       ReDim Preserve FileArray(1 To j) 
       ReDim Preserve FileStatusArray(1 To j) 
       If myArray(i, 1) = objFile.Name Then 
        FileArray(j) = objFile.Name 
        Cells(i + 1, colNumStatus) = "Unchanged" 
        FileStatusArray(j) = "Unchanged" 
        GoTo NextFile 
       Else 
        FileArray(j) = objFile.Name 
        FileStatusArray(j) = "New" 
       End If 
      Next i 
NextFile: 
      j = j + 1 
     End If 
    Next objFile 

    For k = LBound(FileArray) To UBound(FileArray) 
     For l = LBound(myArray) To UBound(myArray) 
      If Not myArray(l, 1) = FileArray(k) Then 
       Cells(l + 1, colNumStatus) = "Missing" 
       GoTo AnotherFile 
      Else 
        Cells(l + 1, colNumStatus) = "Unchanged" 
      End If 
      Next l 
AnotherFile: 

     If FileStatusArray(k) = "New" Then 
      Set newRow = myTable.ListRows.Add(AlwaysInsert:=True) 
      Set myTable = Worksheets(wsName).ListObjects(tbName) 
      newRow.Range.Cells(1, colNumStatus) = "New" 
      newRow.Range.Cells(1, colNumFile) = FileArray(k) 
     End If 
    Next k 
Else 
    For Each objFile In objFolder.Files 
     If objFile.Type = "PNG image" Then 
      ReDim Preserve FileArray(1 To h) 
      ReDim Preserve FileStatusArray(1 To h) 
      FileArray(h) = objFile.Name 
      FileStatusArray(h) = "New" 
      h = h + 1 
     End If 
    Next objFile 

    For g = LBound(FileArray) To UBound(FileArray) 
     Set newRow = myTable.ListRows.Add(AlwaysInsert:=True) 
     Set myTable = Worksheets(wsName).ListObjects(tbName) 
     newRow.Range.Cells(1, colNumStatus) = "New" 
     newRow.Range.Cells(1, colNumFile) = FileArray(g) 
    Next g 
End If 

End Sub 

고마워요!

Answer 1

범위 또는 배열을 여러 번 반복하는 대신 값을 사전에 추가하는 것을 선호합니다. 또한 큰 서브 루틴을 더 작은 작업으로 분해하려고합니다.

Sub FolderContents() 
    Application.ScreenUpdating = False 
    ' Change only these values if name of table or worksheets change 
    Const wsName = "Signage List" 'Worksheet name that contains the signage table 
    Const tbName = "Signage"  'Table name for the signage file data 
    Const fnName = "Filename"  'Column name that contains the file names 
    Const fsName = "File Status" 'Column name that contains the file statuses 
    Dim dImageFiles 
    Dim tblSignage As ListObject 
    Dim newRow As Range 
    Dim k As String 

    Dim x As Long, colNumFile As Long, colNumStatus As Long 

    Set dImageFiles = getSignageImageFilesDictionary 

    If dImageFiles.Count = 0 Then 
     ' Do Something if no folder was selected 
    End If 

    Set tblSignage = Worksheets(wsName).ListObjects(tbName) 

    With tblSignage 
     colNumFile = .ListColumns(fnName).Index 
     colNumStatus = .ListColumns(fsName).Index 
     With .DataBodyRange 
      For x = 1 To .Rows.Count 
       k = .Cells(x, colNumFile).Text 
       If dImageFiles.Exists(k) Then 
        .Cells(x, colNumStatus) = "Unchanged" 
        dImageFiles.Remove k 
       Else 
        .Cells(x, colNumStatus) = "Missing" 
       End If 

      Next x 

     End With 
    End With 

    For x = 0 To dImageFiles.Count - 1 
     Set newRow = tblSignage.ListRows.Add(AlwaysInsert:=True).Range 
     newRow.Cells(1, colNumFile) = dImageFiles.keys(x) 
     newRow.Cells(1, colNumStatus) = "New" 
    Next x 

    Application.ScreenUpdating = True 
End Sub 

Function getSignageImageFilesDictionary() 
    Dim folderPath As String 
    Dim dict, fso, f 

    Set dict = CreateObject("Scripting.Dictionary") 
    Set fso = CreateObject("Scripting.FileSystemObject") 

    folderPath = getFolderPath 
    If Len(folderPath) Then 
     For Each f In fso.GetFolder(folderPath).Files 

      If fso.GetExtensionName(f.Path) = "png" Then 
       If Not dict.Exists(f.Name) Then dict.Add f.Name, f.Path 
      End If 

     Next 
    End If 

    Set getSignageImageFilesDictionary = dict 
    Set fso = Nothing 
End Function 

Function getFolderPath() As String 

    Application.FileDialog(msoFileDialogFolderPicker).ButtonName = "Select Folder" 

    With Application.FileDialog(msoFileDialogFolderPicker) 
     .AllowMultiSelect = False 
     .Title = "Select destination folder" 
     If .Show = -1 And .SelectedItems.Count = 1 Then 
      getFolderPath = .SelectedItems(1) 
     Else: Exit Function 
     End If 
    End With 

End Function 

배열을 사용할 이유가 없습니다. 많은 양의 데이터를 다루는 경우 테이블의 databodyrange를 전 환하여 하나의 다차원 배열을 만들었을 것입니다. 배열의 마지막 차원 만 크기를 조정할 수 있기 때문에 배치를 바꿔야합니다. 다음은 배열의 값을 입력하고 새 행을 추가 할 수 있습니다. 마지막으로, 우리는 array를 existiong databodyrange 위로 조 변경합니다.

Sub FolderContents() 
    ' Change only these values if name of table or worksheets change 
    Const wsName = "Signage List"  'Worksheet name that contains the signage table 
    Const tbName = "Signage"   'Table name for the signage file data 
    Const fnName = "Filename"   'Column name that contains the file names 
    Const fsName = "File Status"  'Column name that contains the file statuses 
    Dim dImageFiles 
    Dim tblSignage As ListObject 
    Dim k As String 
    Dim x As Long, count As Long, colCount As Long, colNumFile As Long, colNumStatus As Long 
    Dim arData, v 

    Set dImageFiles = getSignageImageFilesDictionary 

    If dImageFiles.count = 0 Then 
     ' Do Something if no folder was selected 
    End If 

    Set tblSignage = Worksheets(wsName).ListObjects(tbName) 

    With tblSignage 
     colNumFile = .ListColumns(fnName).Index 
     colNumStatus = .ListColumns(fsName).Index 
     colCount = .DataBodyRange.Columns.count 

     arData = WorksheetFunction.Transpose(.DataBodyRange) 

     For x = 1 To UBound(arData, 2) 

      k = arData(colNumFile, x) 
      If dImageFiles.Exists(k) Then 
       arData(colNumStatus, x) = "Unchanged" 
       dImageFiles.Remove k 
      Else 
       arData(colNumStatus, x) = "Missing" 
      End If 
     Next x 

     For Each v In dImageFiles.keys() 
      count = UBound(arData, 2) + 1 
      ReDim Preserve arData(1 To colCount, 1 To count) 
      arData(colNumFile, count) = v 
      arData(colNumStatus, count) = "New" 
     Next v 

     .DataBodyRange.Cells(1, 1).Resize(UBound(arData, 2), colCount) = WorksheetFunction.Transpose(arData) 

    End With 

End Sub