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
查找差异