application.filesearch zamena

[ gledanost @ 20.06.2012. 11:15 ] @

Moze li neko da izmeni ovaj kod kako bi radio u office2007 jer je application.filesearch izbacena ? Hvala
Attachovao bih fajl ali ne mogu da nadjem kako da attachujem na ovom sajtu. Il sam glup ili corav :)

Code:

Sub btnRadi_Click()
    Dim lngCount As Long
    Dim folder As String
    ' Otvara File dialog open za izbor foldera gde vrsiti pretragu
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        ' Prikazuje putanju svakog selektovanog foldera
        For lngCount = 1 To .SelectedItems.Count
            folder = .SelectedItems(lngCount)
        Next lngCount
    End With
    ' ako je odabrano Cancle procedura se prekida
    If lngCount = 1 Then
        Exit Sub
    End If

    With Application.FileSearch
        .NewSearch
        .LookIn = folder
        .SearchSubFolders = True
        .MatchAllWordForms = True
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            MsgBox "Pronadjeno je " & .FoundFiles.Count & _
            " fajl(ova)."
            For i = 1 To .FoundFiles.Count
                pron = .FoundFiles(i)
                k = 1
                Do Until Left(Right(pron, k), 1) = "\"
                    k = k + 1
                Loop
                pron = Right(pron, k - 1)
                Cells(i, 1) = pron
            Next i
        Else
            MsgBox "Nije pronadjen nijedan fajl."
        End If
    End With
End Sub

_{[Ovu poruku je menjao 3okc dana 20.06.2012. u 14:05 GMT+1]}

[ FOX028 @ 20.06.2012. 12:18 ] @

I ja sam imao istih problema, kod koji si naveo ne radi u 2007, meni je bilo potrebno za Access pa sam morao da guglam. U prilogu ti je fajl sa preradjenim kodom za Excel koji radi i u 2003 i u 2007 za ostale nisam proba.

[ gledanost @ 20.06.2012. 12:28 ] @

Da radi, a jel moze da mi ne daje ime cele putanje C:\Dociments... itd vec samo ime sveske odnosno fajla ?

[ FOX028 @ 20.06.2012. 12:42 ] @

Ovako nesto?

[ gledanost @ 20.06.2012. 12:54 ] @

Da mnogo bolje :). Hvala puno, a reci mi moze li i ovo .xls na kraju da se skloni ( sad sam poceo da zakeram :)) ? Znam da mogu sa funkcijom left ili right ali ako moze odmah bilo bi bolje. Znas li mozda da ispravis ovaj kod dole pa da mi kod imena sheetova isto vrati ime bez nastavka .xls ?

Code:

Sub KopirajSheetsIzDatoteka()
    Dim myDir As String, fn As String

    myDir = "C:\Temp" 'path staza do foldera u kojem se nalaze datoteke
    fn = Dir(myDir & "\*.xls") 'extenzija za datoteke iz kojih se kopiraju Sheets

    Do While fn <> ""
        With Workbooks.Open(myDir & "\" & fn)
            With .Sheets("Sheet1") 'Sheet koji se zeli kopirati iz datoteka u folderu
                .Name = "" & fn & "" 'naziv kopiranog sheeta je tipa ime.xls
                .Copy After:=ThisWorkbook.Sheets(1)

            End With
            .Close False
        End With
        fn = Dir
    Loop
End Sub

_{[Edit: tagovi]}

_{[Ovu poruku je menjao 3okc dana 20.06.2012. u 14:06 GMT+1]}

[ 3okc @ 20.06.2012. 13:02 ] @

Radni listovi *nemaju* ekstenziju; fajlovi je imaju. Obrati pažnju na red u kome piše .Name = "" & fn & "" 'naziv kopiranog sheeta je tipa ime.xls

Pretpostavljam da si komentar sam dopisao a da si program preuzeo -ono fn ti je skr. od FileName.

[ FOX028 @ 20.06.2012. 13:08 ] @

Evo bez ekstenzije :-)

Code:
Sub KopirajSheetsIzDatoteka()
    Dim myDir As String, fn As String

    myDir = "C:\Temp" 'path staza do foldera u kojem se nalaze datoteke
    fn = Dir(myDir & "\*.xls") 'extenzija za datoteke iz kojih se kopiraju Sheets

    Do While fn <> ""
        With Workbooks.Open(myDir & "\" & fn)
            With .Sheets("Sheet1") 'Sheet koji se zeli kopirati iz datoteka u folderu
                .Name = "" & Left(fn,Len(fn)-4) & "" 'naziv kopiranog sheeta je tipa ime.xls
                .Copy After:=ThisWorkbook.Sheets(1)

            End With
            .Close False
        End With
        fn = Dir
    Loop
End Sub

Sto se tice koda mislim da bi moglo ovako da se resi, nisam isprobao. Ako ti skrati previse ili ipak prikaze deo ekstenzije u redu gde je .Name (7 red koda) umesto 4 povecaj ili smanji za po 1 zavisi kako ti je potrebno.

[ gledanost @ 20.06.2012. 13:12 ] @

Da znam da listovi nemaju ekstenziju ali on za ime lista uzima ime fajla pa ubacuje ekstenziju, mogu li to nekako da izbegnem ? Nisam ja neki strucnjak, cak se mogu smatrati amaterom i u pravu si preuzeo sam program sa ovog sajta.

[ 3okc @ 20.06.2012. 13:16 ] @

Jednostavnije:

Code:
.Name = replace(fn,".xls","")

[ gledanost @ 20.06.2012. 13:28 ] @

Radi i jedno i drugo savrseno, hvala vam puno.

[ Ivek33 @ 22.06.2012. 22:01 ] @

Citat:

gledanost: Attachovao bih fajl ali ne mogu da nadjem kako da attachujem na ovom sajtu. Il sam glup ili corav :)

Pogledaj link http://www.elitesecurity.org/t326656-0#2161587