Diff
checker
文本
文本
圖像
文檔
Excel
文件夾
Legal
Enterprise
桌面版
定價
登入
下載 Diffchecker 桌面版
比較文本
尋找兩個文字檔案之間的差異
工具
歷史
即時編輯器
摺疊未變更行
關閉換行
檢視
拆分
統一
比對精度
智能
單詞
字符
語法突出顯示
選擇語法
忽略
文字轉換
前往第一個差異
編輯輸入
Diffchecker Desktop
執行Diffchecker最安全的方式。取得Diffchecker桌面應用程式:您的差異永遠不會離開您的電腦!
取得桌面版
Untitled diff
建立於
7 年前
差異永不過期
清除
匯出
分享
解釋
34 刪除
行
總計
刪除
字符
總計
刪除
要繼續使用此功能,請升級到
Diff
checker
Pro
查看價格
73 行
全部複製
32 新增
行
總計
新增
字符
總計
新增
要繼續使用此功能,請升級到
Diff
checker
Pro
查看價格
73 行
全部複製
Sub FileList()
Sub FileList()
Dim V As String
Dim V As String
Dim BrowseFolder As String
Dim BrowseFolder As String
複製
已複製
複製
已複製
'открываем
диалоговое
окно выбора папки
'открываем
окно выбора папки
With Application.FileDialog(msoFileDialogFolderPicker)
With Application.FileDialog(msoFileDialogFolderPicker)
複製
已複製
複製
已複製
.Title = "
Выберите
папку
или
диск"
.Title = "
Оберіть
папку
/
диск"
.Show
.Show
On Error Resume Next
On Error Resume Next
Err.Clear
Err.Clear
V = .SelectedItems(1)
V = .SelectedItems(1)
If Err.Number <> 0 Then
If Err.Number <> 0 Then
複製
已複製
複製
已複製
MsgBox "
Вы ничего
не
выбрали
!"
MsgBox "
Нічого
не
обрано
!"
Exit Sub
Exit Sub
End If
End If
End With
End With
BrowseFolder = CStr(V)
BrowseFolder = CStr(V)
複製
已複製
複製
已複製
'добавляем лист и выводим
на
него шапку таблицы
'добавляем лист и выводим
в
него шапку таблицы
ActiveWorkbook.Sheets.Add
Sheets("Information").Select
Worksheets("Information").Range("A1:E" & Range("A65536").End(xlUp).Row).ClearContents
With Range("A1:E1")
With Range("A1:E1")
.Font.Bold = True
.Font.Bold = True
.Font.Size = 12
.Font.Size = 12
End With
End With
複製
已複製
複製
已複製
Range("A1").Value = "
Имя
файл
а
"
Range("A1").Value = "
ім'я
файл
у
"
Range("B1").Value = "
Путь
"
Range("B1").Value = "
розташування
"
Range("C1").Value = "
Размер
"
Range("C1").Value = "
розмір
"
Range("D1").Value = "
Д
ата
создания
"
Range("D1").Value = "
д
ата
створення
"
Range("E1").Value = "
Д
ата
изменения"
Range("E1").Value = "
д
ата
зміни"
'
вызываем
процедур
у
вывода списка
файлов
'
вызов
процедур
ы
вывода списка
, если
надо - true
'измените True на False
, если
не нужно выводить файлы из вложенных папок
ListFilesInFolder BrowseFolder,
False
ListFilesInFolder BrowseFolder,
True
End Sub
End Sub
複製
已複製
複製
已複製
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSub
F
olders As Boolean)
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSub
f
olders As Boolean)
Dim FSO As Object
Dim FSO As Object
Dim SourceFolder As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim FileItem As Object
Dim r As Long
Dim r As Long
複製
已複製
複製
已複製
Set FSO = CreateObject("Scripting.FileSystemObject")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.getfolder(SourceFolderName)
Set SourceFolder = FSO.getfolder(SourceFolderName)
複製
已複製
複製
已複製
r = Range("A65536").End(xlUp).Row + 1
'находи
м первую
пустую строку
r = Range("A65536").End(xlUp).Row + 1
'находи
им 1ю
пустую строку
'выводим данные по файлу
'выводим данные по файлу
For Each FileItem In SourceFolder.Files
For Each FileItem In SourceFolder.Files
Cells(r, 1).Formula = FileItem.Name
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Path
Cells(r, 2).Formula = FileItem.Path
Cells(r, 3).Formula = FileItem.Size
Cells(r, 3).Formula = FileItem.Size
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastModified
Cells(r, 5).Formula = FileItem.DateLastModified
r = r + 1
r = r + 1
複製
已複製
複製
已複製
X = Source
Folder.Path
X = Source
.
Folder.Path
Next FileItem
Next FileItem
複製
已複製
複製
已複製
'
вызываем
процедур
у повторно
для каждой вложенной папки
'
повторная
процедур
а
для каждой вложенной папки
If IncludeSub
f
olders Then
If IncludeSub
F
olders Then
For Each SubFolder In SourceFolder.SubFolders
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
ListFilesInFolder SubFolder.Path, True
Next SubFolder
Next SubFolder
End If
End If
複製
已複製
複製
已複製
Columns("A:E").AutoFit
Columns("A:E").AutoFit
複製
已複製
複製
已複製
Set FileItem = Nothing
Set FileItem = Nothing
Set SourceFolder = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
Set FSO = Nothing
複製
已複製
複製
已複製
End Sub
End Sub
已保存差異
原始文本
開啟檔案
Sub FileList() Dim V As String Dim BrowseFolder As String 'открываем диалоговое окно выбора папки With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Выберите папку или диск" .Show On Error Resume Next Err.Clear V = .SelectedItems(1) If Err.Number <> 0 Then MsgBox "Вы ничего не выбрали!" Exit Sub End If End With BrowseFolder = CStr(V) 'добавляем лист и выводим на него шапку таблицы ActiveWorkbook.Sheets.Add With Range("A1:E1") .Font.Bold = True .Font.Size = 12 End With Range("A1").Value = "Имя файла" Range("B1").Value = "Путь" Range("C1").Value = "Размер" Range("D1").Value = "Дата создания" Range("E1").Value = "Дата изменения" 'вызываем процедуру вывода списка файлов 'измените True на False, если не нужно выводить файлы из вложенных папок ListFilesInFolder BrowseFolder, True End Sub Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean) Dim FSO As Object Dim SourceFolder As Object Dim SubFolder As Object Dim FileItem As Object Dim r As Long Set FSO = CreateObject("Scripting.FileSystemObject") Set SourceFolder = FSO.getfolder(SourceFolderName) r = Range("A65536").End(xlUp).Row + 1 'находим первую пустую строку 'выводим данные по файлу For Each FileItem In SourceFolder.Files Cells(r, 1).Formula = FileItem.Name Cells(r, 2).Formula = FileItem.Path Cells(r, 3).Formula = FileItem.Size Cells(r, 4).Formula = FileItem.DateCreated Cells(r, 5).Formula = FileItem.DateLastModified r = r + 1 X = SourceFolder.Path Next FileItem 'вызываем процедуру повторно для каждой вложенной папки If IncludeSubfolders Then For Each SubFolder In SourceFolder.SubFolders ListFilesInFolder SubFolder.Path, True Next SubFolder End If Columns("A:E").AutoFit Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
更改後文本
開啟檔案
Sub FileList() Dim V As String Dim BrowseFolder As String 'открываем окно выбора папки With Application.FileDialog(msoFileDialogFolderPicker) .Title = "Оберіть папку/диск" .Show On Error Resume Next Err.Clear V = .SelectedItems(1) If Err.Number <> 0 Then MsgBox "Нічого не обрано!" Exit Sub End If End With BrowseFolder = CStr(V) 'добавляем лист и выводим в него шапку таблицы Sheets("Information").Select Worksheets("Information").Range("A1:E" & Range("A65536").End(xlUp).Row).ClearContents With Range("A1:E1") .Font.Bold = True .Font.Size = 12 End With Range("A1").Value = "ім'я файлу" Range("B1").Value = "розташування" Range("C1").Value = "розмір" Range("D1").Value = "дата створення" Range("E1").Value = "дата зміни" 'вызов процедуры вывода списка, если надо - true ListFilesInFolder BrowseFolder, False End Sub Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubFolders As Boolean) Dim FSO As Object Dim SourceFolder As Object Dim SubFolder As Object Dim FileItem As Object Dim r As Long Set FSO = CreateObject("Scripting.FileSystemObject") Set SourceFolder = FSO.getfolder(SourceFolderName) r = Range("A65536").End(xlUp).Row + 1 'находиим 1ю пустую строку 'выводим данные по файлу For Each FileItem In SourceFolder.Files Cells(r, 1).Formula = FileItem.Name Cells(r, 2).Formula = FileItem.Path Cells(r, 3).Formula = FileItem.Size Cells(r, 4).Formula = FileItem.DateCreated Cells(r, 5).Formula = FileItem.DateLastModified r = r + 1 X = Source.Folder.Path Next FileItem 'повторная процедура для каждой вложенной папки If IncludeSubFolders Then For Each SubFolder In SourceFolder.SubFolders ListFilesInFolder SubFolder.Path, True Next SubFolder End If Columns("A:E").AutoFit Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing End Sub
尋找差異