🚀 go-pugleaf

Użytkownik "Paweł" <gamacdur@op.pl> napisał w wiadomości 
news:4d68ed34$0$2507$65785112@news.neostrada.pl...
> Witam
>
> Chciałbym się zapytać jak można za pomocą VBA otrzymać w Word 2007, w 
> zmiennej typu string listę wszystkich plików np. txt, które znajdują się w 
> podanej ścieżce jak również w podfolderach.
> Znalazłem przykład takiej funkcji ale potrzebuję jej wynik przekierować do 
> zmiennej string,  a więc chcę otrzymać coś takiego
>
> Sub test()
>
> Dim listaplików As String
>
> listaplików = call ListFiles("c:temp", "*.txt", true)
>
> end sub
>
> Jak najprościej to zrobić ??
>
> Pozdrawiam Paweł

Link do tej funkcji to: http://allenbrowne.com/ser-59.html

> Link do tej funkcji to: http://allenbrowne.com/ser-59.html

No ale w czym problem ?
Nie znasz VBA czy angielskiego ?

robin

Użytkownik "InDesign Scripts" <indesignscripts@gazeta.pl> napisał w 
wiadomości news:ikassl$ge6$1@inews.gazeta.pl...
>> Link do tej funkcji to: http://allenbrowne.com/ser-59.html
>
> No ale w czym problem ?
> Nie znasz VBA czy angielskiego ?
>
> robin

Witam
Kłopot jest z kodem VBA gdyż to co napisałem tj.

     listaplików = (call ListFiles("c:\temp", "*.txt", true))

poprostu nie działa krzycząc, że jest błąd kompilacji, natomiast

    listaplików = (ListFiles("c:\temp", "*.mdb", True))

niby się wykonuje gdyż w okienku Immediate pojawiają się poszukiwane pliki 
ale sama zmienna listaplików jest pusta !!!

> Kłopot jest z kodem VBA gdyż to co napisałem tj.
> 
>     listaplików = (call ListFiles("c:\temp", "*.txt", true))
> 
> poprostu nie działa krzycząc, że jest błąd kompilacji, natomiast

Czyli nie znasz VBA ;)

Nie możesz w nawiasie dać "CALL" - bo "CALL" jest zarezerwowanym słowem kluczowym i może być używane tylko na początku wiersz przy wywoływaniu funkcji lub procedur

>    listaplików = (ListFiles("c:\temp", "*.mdb", True))
> 
> niby się wykonuje gdyż w okienku Immediate pojawiają się poszukiwane 
> pliki ale sama zmienna listaplików jest pusta !!!

Bo ListFiles nie zwraca wyniku:
Public Function ListFiles(...)

Jeżeli już - to musiałbyś zmodyfikować treść tej funkcji:

i zamiast:

    'Add the files to a list box if one was passed in. Otherwise list to the Immediate Window.
    If lst Is Nothing Then
        For Each varItem In colDirList
            Debug.Print varItem
        Next
    Else
        For Each varItem In colDirList
        lst.AddItem varItem
        Next
    End If

coś takiego:

    For Each varItem In colDirList
        ListFiles = ListFiles & varItem & vbCr
    Next

i dodatkowo zmodyfikować nagłówek:

    Public Function ListFiles(...) As String

oczywiście musisz zamiast (...) wpisać pełną/oryginalną listę argumentów

robin

Dosyć podobne rozwiązanie:

'w znacznej części na podstawie:
'http://www.datastrat.com/Download/Picture2K.zip
'http://msdn.microsoft.com/en-us/library/dk008ty4.aspx
'Dir Function

Private Sub ReadFolderInfo(listaPlikow As String, _
                           strFolder As String, _
                           subfold As Boolean, _
                           strExt As String, _
                           nLevels As Long, _
                           Optional ByVal nLevel As Long)

Dim arrFolders() As String
ReDim arrFolders(19) As String 'do 20 podkatalogów na początek
Dim strRelFolder As String
Dim strFile As String
Dim nLen As Long 'żeby dwa razy nie obliczać długości folderu
Dim iLoop As Long, iLoop2 As Long

strFile = Dir(strFolder, vbDirectory)
iLoop = -1

While strFile <> ""

    'wykluczenie "/.." zapobiega wchodzeniu na wyższy folder, "/." do
siebie samego
    'maksymalna długość ścieżki to 260 (259 + Null), ale zdarzają się
pliki dłuższe
    If strFile <> "." And strFile <> ".." And strFile <> "" And
Len(strFolder & strFile) < 260 Then
        'Display the names in E:\ that represent directories.
        'Use bitwise comparison to make sure strFile is a directory.
            On Error Resume Next
        If (GetAttr(strFolder & strFile) And vbDirectory) =
vbDirectory Then
            'dzięki Resume Next można by pominąć warunek And
Len(strFolder & strFile) < 260
            If Err > 0 Then
                Err.Clear
                On Error GoTo 0 'też --> Err = 0 jak po Err.Clear
                GoTo nastepny_plik
            End If
            On Error GoTo 0

            iLoop = iLoop + 1
            If iLoop > UBound(arrFolders) Then ReDim Preserve
arrFolders(iLoop)
            arrFolders(iLoop) = strFile 'podkatalog do sprawdzenia w
kolejnym ReadFolderInfo

        'pliki inne niż katalogi
        Else
            On Error GoTo 0
            If InStr(Right(strFile, Len(strExt)), strExt) > 0 Then _
                    listaPlikow = listaPlikow & vbNewLine & strFolder
& strFile
        End If
    End If '., ..

nastepny_plik:
    strFile = Dir() ' Get next entry

Wend 'Loop

If subfold Then
    'arrFolders() - podkatalogi zapisane w kolejnych
    'If (GetAttr( ... powyższej pętli While
    nLevel = nLevel + 1
    'Debug.Print nLevel & "  " & nLevels
    If nLevels <> -1 And nLevel > nLevels Then Exit Sub
    For iLoop2 = 0 To iLoop
        ReadFolderInfo listaPlikow, strFolder & arrFolders(iLoop2) &
"\", subfold, strExt, nLevels, nLevel
    Next iLoop2
End If

End Sub

Sub wypisz_nazwy()

Dim listaPlikow As String

'katalog musi być ze slashem "\" na końcu
Call ReadFolderInfo(listaPlikow, "E:\Documents and Settings
\Administrator\My Documents\Bazy danych\", True, "txt", -1)
'True czyli z podkatalogami
'-1 czyli wszystkie poziomy w dół
'wyświtela same nazwy po zamianie
'listaPlikow = listaPlikow & vbNewLine & strFolder & strFile
'na
'listaPlikow = listaPlikow & vbNewLine & strFile

Debug.Print listaPlikow

End Sub