0
私はディレクトリの内容をスキャンし、そのスキャンの結果でテーブルを更新するためにvbaスクリプトを作成しています。結果は、ファイルがUnchanged、New、Missingのいずれかであり、テーブルのFile Status列に更新されます。新規の場合は、ファイル名を表のFilename列に入れます。ExcelのVBAでディレクトリの内容をスキャンしてテーブルを更新します
私はかなり近いコードを持っていますが、私は2つの配列を通過するロジックのいくつかに問題があります。私はコード内でより多くの問題を引き起こすことなくこれを見る能力を使い果たしました。さらなる変更はコード内で回帰を引き起こしています。
誰もコードを見て、私が正しい道にいるかどうか、または私が作った簡単な間違いがあるかどうかを確認できますか？誤っていくつかのファイルが見つからないか、新しいファイルではないとマークしていますが、何かが間違ってしまう前にUnchangedファイルを最初にマークしていると思います。
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
ありがとうございます！