Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Вопрос-Ответ Новый топик    Ответить
Топик располагается на нескольких страницах: Ctrl  назад   1 [2] 3   вперед  Ctrl      все
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

Ладно, погодите малость... сделаю в Эксель вывод....

Posted via ActualForum NNTP Server 1.3

23 фев 06, 19:06    [2385806]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003
Вроде работает (Office XP), хотя есть небольшие ограничения - количество файлов + папок 65000 примерно и глубина вложенности папок не более 27 (если не ошибаюсь)

Private subf As Folder
Private indent As Integer
Private r As Long
Private sh As Worksheet


Sub test() ' вход здесь
  Dim fso As New Scripting.FileSystemObject
  Dim fld As Folder
  Set fld = fso.GetFolder("r:\") ' Интересующий диск или папка
  Set sh = Application.ActiveSheet
  indent = 1
  r = 1
  addFromFolder fld
End Sub
  

Private Sub addFromFolder(ByVal fld As Folder)
  If indent = 1 Then
    sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "Папка """ & fld.Name & """"
  Else
    sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "Папка """ & fld.Name & """ в папке """ & fld.ParentFolder.Name & """"
  End If
  r = r + 1
  
  indent = indent + 1 ' увеличить отступ
  For Each subf In fld.SubFolders ' обработка вложенных папок
    addFromFolder subf ' рекурсивный вызов
  Next
  indent = indent - 1 ' уменьшить отступ
  
  For Each f In fld.Files ' обработка файлов папки
    sh.Range(Chr(65 + indent + 1) & CStr(r)).Value2 = "Файл """ & f.Name & """"
    r = r + 1
  Next
  
  If indent = 1 Then
    sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "Конец папки """ & fld.Name & """"
  Else
    sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "Конец папки """ & fld.Name & """ в папке """ & fld.ParentFolder.Name & """"
  End If
  r = r + 1
End Sub

23 фев 06, 19:24    [2385833]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003
Чуть не забыл, в рефренсах надо подключить библиотеку Microsoft Scripting Runtime
23 фев 06, 19:26    [2385835]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
spasibo poprobuy
23 фев 06, 20:22    [2385947]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
vkle
Чуть не забыл, в рефренсах надо подключить библиотеку Microsoft Scripting Runtime

da chto to ochen slogno vigladet pridetsja razbiratsja chto k chemu
23 фев 06, 21:03    [2386026]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
спасибо большое но что то не вышло буду на выходных дальше пробывать может заработает
24 фев 06, 11:12    [2386691]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003
Что именно не получилось?

Posted via ActualForum NNTP Server 1.3

24 фев 06, 11:21    [2386710]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
я неочень разбираюсь в макросах темболее в таких больших
если я понимаю правильно то нужно
вот это все записать в макрос
Private subf As Folder
Private indent As Integer
Private r As Long
Private sh As Worksheet


Sub test() ' вход здесь - мне нужно задать в скобках имя макроса да?
  Dim fso As New Scripting.FileSystemObject
  Dim fld As Folder
  Set fld = fso.GetFolder("r:\") ' Интересующий диск или папка- интересует СД диск имя папки + имя файла или только имя файла и только имя папки
  Set sh = Application.ActiveSheet
  indent = 1
  r = 1
  addFromFolder fld
End Sub
  
двлее - нужно задавать каждую папку их уменя более 100 шт а в них еще документы примерно 150 штук нужно прописывать названия каждой так ?
Private Sub addFromFolder(ByVal fld As Folder)
  If indent = 1 Then
    sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "Папка """ & fld.Name & """"
  Else
    sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "Папка """ & fld.Name & """ в папке """ & fld.ParentFolder.Name & """"
  End If
  r = r + 1
  
  indent = indent + 1 ' увеличить отступ
  For Each subf In fld.SubFolders ' обработка вложенных папок
    addFromFolder subf ' рекурсивный вызов
  Next
  indent = indent - 1 ' уменьшить отступ
  
  For Each f In fld.Files ' обработка файлов папки
    sh.Range(Chr(65 + indent + 1) & CStr(r)).Value2 = "Файл """ & f.Name & """"
    r = r + 1
  Next
  
  If indent = 1 Then
    sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "Конец папки """ & fld.Name & """"
  Else
    sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "Конец папки """ & fld.Name & """ в папке """ & fld.ParentFolder.Name & """"
  End If
  r = r + 1
End Sub

[/quot]
24 фев 06, 11:33    [2386738]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

Ага, в макрос

> интересует СД диск имя папки + имя файла или только имя файла и только
имя папки

Можно либо диск\, либо диск\папка_на_диске\

Posted via ActualForum NNTP Server 1.3

24 фев 06, 12:17    [2386838]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

> вход здесь - мне нужно задать в скобках имя макроса да?

Нужно просто выполнить макрос с именем test

Posted via ActualForum NNTP Server 1.3

24 фев 06, 12:18    [2386842]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

> двлее - нужно задавать каждую папку их уменя более 100 шт а в них еще
документы примерно 150 штук нужно прописывать названия каждой так ?

Нет, нужно только указать корневую папку или диск

Posted via ActualForum NNTP Server 1.3

24 фев 06, 12:20    [2386845]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
Set fld = fso.GetFolder("r:\") '- тут просто D
r = 1 - и тут просто D да ?

ПАПКА 1
D:\Уралвторчермет, Екатеринбург

ПАПКА 2
D:\Уралвторчермет, Екатеринбург\Уралвторчермет, Екатеринбург\FUCHS MHL 331 №3311100734 Тула
Папка 3
В НЕЙ ДОКУМЕНТЫ *отсканированые кол-во разное
от 02.02 акт осмотра при вводе
и т д
24 фев 06, 13:07    [2386961]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

Set fld = fso.GetFolder("D:\Уралвторчермет, Екатеринбург\")

Больше ничего не трогать

Posted via ActualForum NNTP Server 1.3

24 фев 06, 13:10    [2386970]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
пытаюсь более подробно изложить и так есть
ПАПКА 1
D:\Уралвторчермет, Екатеринбург
в ней скажем 50 других папок в этих папках н-е кол-во отсканированных документов нужно название последней папки + название отсканированных документов число этих документов разное
ПАПКА 2
D:\Уралвторчермет, Екатеринбург\Уралвторчермет, Екатеринбург\FUCHS MHL 331 №3311100734 Тула
Папка 3
В НЕЙ ДОКУМЕНТЫ *отсканированые кол-во разное
от 02.02 акт осмотра при вводе
и т д[/quot]
24 фев 06, 13:15    [2387001]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

Пытаюсь понять, что у Вас не получилось.

VBA выдает какую то ошибку при запуске скрипта?
Или же Вам хочется разобраться в работе этого скрипта?

Если второе - то просто выполняйте скрипт по шагам и посмотрите как он
работает.
Если первое - то приведите здесь сообщение об ошибке.

Posted via ActualForum NNTP Server 1.3

24 фев 06, 13:32    [2387044]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

Или же формат списка не устраивает?

Posted via ActualForum NNTP Server 1.3

24 фев 06, 13:34    [2387057]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
вот что у меня получилось

Posted via ActualForum NNTP Server 1.3[/quot]
Private subf As Folder
Private indent As Integer
Private r As Long
Private sh As Worksheet


Sub test()
Dim fso As New Scripting.FileSystemObject
Dim fld As Folder
Set fld = fso.GetFolderSet fld = fso.GetFolder("D:\??????????????, ????????????\")
Set sh = Application.ActiveSheet
indent = 1
d = 1
addFromFolder fld
End Sub


Private Sub addFromFolder(ByVal fld As Folder)
If indent = 1 Then
sh.Range(Chr(65 + indent) & CStr(d)).Value2 = "????? """ & fld.Name & """"
Else
sh.Range(Chr(65 + indent) & CStr(d)).Value2 = "????? """ & fld.Name & """ ? ????? """ & fld.ParentFolder.Name & """"
End If
d = d + 1

indent = indent + 1
For Each subf In fld.SubFolders
addFromFolder subf
Next
indent = indent - 1

For Each f In fld.Files
sh.Range(Chr(65 + indent + 1) & CStr(r)).Value2 = "???? """ & f.Name & """"
d = d + 1
Next

If indent = 1 Then
sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "????? ????? """ & fld.Name & """"
Else
sh.Range(Chr(65 + indent) & CStr(r)).Value2 = "????? ????? """ & fld.Name & """ ? ????? """ & fld.ParentFolder.Name & """"
End If
r = r + 1
End Sub
24 фев 06, 13:37    [2387066]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

Откровенно лень сравнивать.
Надеюсь, что Вы поправили только одну строчку :)

Posted via ActualForum NNTP Server 1.3

24 фев 06, 13:39    [2387074]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
vkle

Откровенно лень сравнивать.
Надеюсь, что Вы поправили только одну строчку :)

Posted via ActualForum NNTP Server 1.3

не а я нетолько я заменила и другие r НА d
при запуске сообщение на строку Private subf As Folder
24 фев 06, 13:52    [2387100]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

Библиотека Microsoft Scripting Runtime подключена в рефренсах?

Posted via ActualForum NNTP Server 1.3

24 фев 06, 13:56    [2387122]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003
автор
не а я нетолько я заменила и другие r НА d

Хоть и нехорошо себя цитировать, но если Вы не читаете то что Вам пишут, повторю:
vkle

Set fld = fso.GetFolder("D:\Уралвторчермет, Екатеринбург\")

Больше ничего не трогать

Posted via ActualForum NNTP Server 1.3
24 фев 06, 13:59    [2387133]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
все понятненько исправлю
24 фев 06, 14:09    [2387169]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
vkle

Библиотека Microsoft Scripting Runtime подключена в рефренсах?

Posted via ActualForum NNTP Server 1.3

я так понимаю вы сейчас о VBA говорите или ?
24 фев 06, 14:17    [2387198]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
vkle
Member

Откуда: Самара
Сообщений: 15003

Разумеется. Код, который приведен выше - не что иное, как VBA-макрос для
Екселя.

Posted via ActualForum NNTP Server 1.3

24 фев 06, 14:22    [2387217]     Ответить | Цитировать Сообщить модератору
 Re: подскажите как решить вот такую задачку  [new]
Lenus
Member

Откуда:
Сообщений: 251
vkle

Разумеется. Код, который приведен выше - не что иное, как VBA-макрос для
Екселя.

Posted via ActualForum NNTP Server 1.3

уже понятно только вот с библиотекой ну все сложно я где то читала как подключать библиотеку только забыла как делать это
мне очень неодобно что я вам столько вопросов задаю я попробую на выходных почитать на эту тему после думаю все заработает спасибо вам огромное за помощь
24 фев 06, 14:58    [2387352]     Ответить | Цитировать Сообщить модератору
Топик располагается на нескольких страницах: Ctrl  назад   1 [2] 3   вперед  Ctrl      все
Все форумы / Вопрос-Ответ Ответить