[es] - application.filesearch zamena

gledanost

Član broj: 248525
Poruke: 19
*.dynamic.isp.telekom.rs.

Profil

^{20.06.2012. u 11:15 - pre 145 meseci}

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]}

Odgovor na temu

FOX028
Visoka tehnicka skola strukovnih studija
Kosovska Mitrovica

Član broj: 258986
Poruke: 850

Sajt: https://www.zile028.com

+49 Profil

Re: application.filesearch zamena

^{20.06.2012. u 12:18 - pre 145 meseci}

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.

[email protected]=

Prikačeni fajlovi

Pretraga.xlsm - 21.68k

Odgovor na temu

gledanost

Član broj: 248525
Poruke: 19
*.dynamic.isp.telekom.rs.

Profil

Re: application.filesearch zamena

^{20.06.2012. u 12:28 - pre 145 meseci}

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

Odgovor na temu

FOX028
Visoka tehnicka skola strukovnih studija
Kosovska Mitrovica

Član broj: 258986
Poruke: 850

Sajt: https://www.zile028.com

+49 Profil

Re: application.filesearch zamena

^{20.06.2012. u 12:42 - pre 145 meseci}

Ovako nesto?

[email protected]=

Prikačeni fajlovi

Pretraga.xlsm - 21.75k

Odgovor na temu

gledanost

Član broj: 248525
Poruke: 19
*.dynamic.isp.telekom.rs.

Profil

Re: application.filesearch zamena

^{20.06.2012. u 12:54 - pre 145 meseci}

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]}

Odgovor na temu

3okc
Χoᴘᴦoѡ

Moderator
Član broj: 811
Poruke: 1319

Jabber: 3okc@elitesecurity.org

+116 Profil

Re: application.filesearch zamena

^{20.06.2012. u 13:02 - pre 145 meseci}

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.

Have you found helpful examples, solutions or ideas-in-work, please consider the
following:
• Citation of *actual page* you are going to using is welcome.
• Have you saw "Value Added" examples you are going to incorporate to your
profitable blog, daily job or any money making venture: How about online donation?
↗Ana & Vlade Divac Foundation
Hvala!

Odgovor na temu

FOX028
Visoka tehnicka skola strukovnih studija
Kosovska Mitrovica

Član broj: 258986
Poruke: 850

Sajt: https://www.zile028.com

+49 Profil

Re: application.filesearch zamena

^{20.06.2012. u 13:08 - pre 145 meseci}

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.

[email protected]=

Prikačeni fajlovi

Pretraga.xlsm - 21.88k

Odgovor na temu

gledanost

Član broj: 248525
Poruke: 19
*.dynamic.isp.telekom.rs.

Profil

Re: application.filesearch zamena

^{20.06.2012. u 13:12 - pre 145 meseci}

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.

Odgovor na temu

3okc
Χoᴘᴦoѡ

Moderator
Član broj: 811
Poruke: 1319

Jabber: 3okc@elitesecurity.org

+116 Profil

Re: application.filesearch zamena

^{20.06.2012. u 13:16 - pre 145 meseci}

Jednostavnije:

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

Odgovor na temu

gledanost

Član broj: 248525
Poruke: 19
*.dynamic.isp.telekom.rs.

Profil

Re: application.filesearch zamena

^{20.06.2012. u 13:28 - pre 145 meseci}

Radi i jedno i drugo savrseno, hvala vam puno.

Odgovor na temu

Ivek33

Član broj: 66174
Poruke: 2898

+66 Profil

Re: application.filesearch zamena

^{22.06.2012. u 22:01 - pre 145 meseci}

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

Odgovor na temu