Příspěvky uživatele


< návrat zpět

Strana:  1 2   další »

Už bol večer a asi som už driemal. Dnes som sa nato pozrel kód si odkrokoval a našiel chybu. Samozrejme bola u mňa, takže ďakujem a funguje.

marjankaj celkom nechápem kde sa tam maju tie stlpce menit.

elninoslov celkom chápem princíp, ale nefunguje mi to spraví to len stĺpec D a K ostatne to vynechá.

Pomáhal som si záznamom makra a potom to upravoval tak sú tam ešte nedostatky.

Ahojte, mam macro a vnom dlhu cast kodu v ktorom je tento riadok Range("D4:D200").Select potreboval by som tu cast zopakovat tak aby bolo zakazdym ine pismeno cize stlpec. Pismena musia byt v tomto poradi D,G,H,I,J,K.
Vedel by som tu cast napisat 6x pod seba a fungovalo by to, ale chcel by som vidiet spôsob ako sa to má robit. Dakujem ak si niekto nájde čas.

"Nie, zmena toho riadku iba spôsobí, že sa dáta neprepíšu od bunky A2, ale pridajú sa až za poslednou vyplnenou v stĺpci A. Teda vyhovenie požiadavke neprepisovania, ale pridávania."

Chapem ale pridaju sa tam aj dáta ktoré už v zozname sú a to mi tiež nevyhovuje.
Tiež to nechcem komplikovať viac ako to je. Môžu byť 2 skripty s 2 roznymy cestamy pre 2 rozdielne disky a každý by bol na inom hárku. Viem že keby to chcem blbuvzorné tak mi to nikto zadarmo nenapíše lebo by ten kód bol na 2000 riadkov.
Skúsim napísať ako by som si predstavoval body čo ste rozpísali, potom mi prosím napíšte či by to bolo jednoducho realizovatelné alebo nejak strašne zložité.
"""Ak film fyzicky zmažem, spustím makro, ako makro zistí, či som film zmazal alebo či tam nikdy nebol?"""
Tak keď nieje na disku tak ho odstráni aj z databázy.
"""Spustím makro s diskom ABC, bude tam film Avatar.mkv. Potom spustím makro na disku DEF, kde bude tiež Avatar.mkv. Čo teraz? Je to iný film s rovnakým názvom? Rovnaký v inej kvalite? Ten istý iba presunutý na iný disk? Odkiaľ toto makro zistí? Dajme tomu, že keď je z iného disku, tak sa pridá. Teda budú tam dva Avatar.mkv. Potom ho presuniem na tretí disk, alebo do iného adresára. Spustím makro, a čo teraz? Pridá tretí? Zmaže prvý, druhý, ... ?"""
No bude tam predsa aj ten názov disku a každý disk sa bude volať ináč tak podľa toho to bude vedieť.Do tej databázy by som to chcel tak že čo je na disku to je v databáze.

Popravde s databazou som ešte nepracoval, ale ako píšete priradovať ID k dátam by bolo asi najlepšie.
Ako píšete do toho zoznamu/databázy by sa mali dostať všetky filmy z disku a nemali by sa tam opakovať. Ak pridám na disk dalši film alebo nejaky vymažem tak aby sa do databazy pridal len ten alebo aby z nej len ten zmizol. To s tým názvom disku som chcel samozrejme na všetky riadky, len som sa k tomu ešte nedostal.

Skúsil som zmenit ten kod ako ste mi radili
END_PROC:

If bPrint Then Sheets("Hárok2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(CountFiles, 6).Value = Application.Transpose(Info): Sheets("Hárok2").Activate

ale zoznam sa duplicitoval či mám nechať aj ten prikaz na mazanie zoznamu čo je na začiatku?

No premyslím si to ešte a skúsim si to nejak utriediť a rozkresliť na papier čo by to malo robiť.

Vdaka oprava funguje. Bol by som ti vdačný ak by si mi s tým pomáhal aj dalej. Zatial teda dakujem a ozvi sa ked budeš mať čas.

A teraz som vlastne zistil že tam nemôže byť to mazanie toho zoznamu čo je hned na začiatku. Tie dáta chcem použit ako databázu a dalej s nimi pracovať a priradovat k nim veci.
Teraz som zistil že ak to zmažem a znova načítam tak mi tie veci čo som knim priradil náhodne priradí k iným filmom. Dúfam že ma chápete.

Edit: tak som zistil že ten tvoj bude dobrý lebo stačilo odstrániť to mazanie a ked ho opakovane spúštam tak tam nerobí duplicity ako ten čo som mal predtým. Takže to je ok.

Vdaka s progress barom sa netráp to nepotrebujem. Len mi to nefunguje ak napíšem H:\ ,musím začat s priečinkom napr. H:\Filmy budem si nad tým lámať hlavu kým mi to nespravíš ty :D alebo sa mi to zázrakom podarí, pretože si ten script celý prerobil a strácam sa tam :D

No este pockam ak sa nik nepodujme tak tam skusim toto dat aspon 6x a to by mi malo stacit.

For Each kategorie In objFolder.subfolders
For Each film In kategorie.subfolders

Ten súbor som našiel a snažil som sa to upraviť no je to namna moc zložité a nepodarilo sa mi to.

Skúsim to vysvetliť asi som spravil chybu že som dal len časť kódu, myslel som že to bude stačiť. Ak je cesta H:\Filmy\Robocop\Robocop.mkv
funguje to.
Ak je cesta dlhšia o jeden alebo viac podpriečinkov napr.
H:\Filmy\Robocop\novy\Robocop.mkv
tak to už nefunguje.
S tým "PrintFiles" sa dalej pracuje ale tam podla mna problém nieje ale tu je celý kód.
Má to nájsť všetky filmy na disku a vytvoriť zoznam s podrobnostami cestami velkostami atd.
Sub PrintFolders() 'testovaci
Dim objFSO As Object
Dim objFolder As Object
Dim kategorie As Object
Dim film As Object
Dim folder As String

Sheets("Hárok2").Range("A2:F" & Sheets("Hárok2").Range("A99999").End(xlUp).Row).ClearContents
Application.StatusBar = ""
folder = Sheets("Hárok1").Range("B2").Value & ":\"

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(folder)
i = 1
'On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler

For Each kategorie In objFolder.subfolders

For Each film In kategorie.subfolders

Call PrintFiles(film.Path)
Call ShowVolumeInfo

Next film
Next kategorie
handleCancel:
If Err = 18 Then
MsgBox "You cancelled"
End If
End Sub

Sub PrintFiles(ByVal FolderName As String)
Dim fsObj, FD, fs, Fl As Object
Dim FullPath, nameoffile As String
Dim Velikost As Long
Dim radek As Long

radI = 2

Set fsObj = CreateObject("Scripting.FileSystemObject")
Set FD = fsObj.GetFolder(FolderName)
Set fs = FD.Files

For Each Fl In fs
radek = Sheets("Hárok2").Range("A99999").End(xlUp).Row + 1
nameoffile = Fl.Name

Sheets("Hárok2").Cells(radek, 1) = Fl.Path
Sheets("Hárok2").Cells(radek, 2) = GetProperties(Fl.Path, 0) 'nazov
Sheets("Hárok2").Cells(radek, 3) = GetProperties(Fl.Path, 190) 'priecinok v ktorom je subor
Sheets("Hárok2").Cells(radek, 4) = GetProperties(Fl.Path, 164) 'pripona
Sheets("Hárok2").Cells(radek, 5) = GetProperties(Fl.Path, 1) 'velkost
Sheets("Hárok2").Cells(radek, 6) = GetProperties(Fl.Path, 27) 'trvanie

Next

Set fsObj = Nothing
Set FD = Nothing
Set fs = Nothing
End Sub
Sub ShowVolumeInfo() 'ziska nazov disku
Dim fs, d, s
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName(Range("A2").Value)))
s = d.VolumeName
Range("G2") = s
End Sub

Zdravím. Kód mi robí to že nájde súbor v priečinkoch, avšak ide iba do 2 podpriečinkov ak je ich viac vypíše chybu. Vedeli by ste mi pomôct? Ako mám spraviť to aby súbor našlo aj ked bude podpriečinkov povedzme 10. Vedel by som tam pridať 10x for each ale čo ak bude podpriečinkov 11 chcel by som to mať nejak automacické snád chápete ako to myslím.Sub PrintFolders() 'testovaci
Dim objFSO As Object
Dim objFolder As Object
Dim kategorie As Object
Dim film As Object
Dim folder As String

Sheets("Hárok2").Range("A2:F" & Sheets("Hárok2").Range("A99999").End(xlUp).Row).ClearContents
Application.StatusBar = ""
folder = Sheets("Hárok1").Range("B2").Value & ":\"

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder(folder)
i = 1
'On Error GoTo handleCancel
Application.EnableCancelKey = xlErrorHandler

For Each kategorie In objFolder.subfolders

For Each film In kategorie.subfolders

Call PrintFiles(film.Path)

Next film
Next kategorie
handleCancel:
If Err = 18 Then
MsgBox "You cancelled"
End If
End Sub

Dakujem skúšal som a funguje,len s chybičkami.Ak sú v priečinku 2 alebo viac filmov vypíše len jeden. A každým spustením sa hodnoty zapíšu už pod existujúci zoznam čiže tam potom vznikajú duplicity. Vlastne ked som tak rozmýšlal, lepšie by bolo aby sa tie hodnoty čo už v tabulke sú znova neprepisovali a nové sa pridaly naspodok.

Tak som znova niečo skúsil a ten modul 3 mi dáva všetky informácie v takom tvare ako by som chcel, len tam treba zadať kompletnú cestu k súboru nevyhladá súbory sám.
Teraz ma čaká skombinovať všetky tri moduly čo tam mám nejak do jedného. S tým budem asi potrebovať pomoc.

Našiel som spôsob ako čítať názov disku je v module 2
Dotazy mi nikdy nefungovali správne vždy to nejak sekalo a nešlo to. Skúšal som ten čo si mi poslala ale nejak nechce načitavať údaje.
Ja sa s tým ešte pohrám a dám vedieť lebo ešte sám nemám premyslené ako by som to vlastne chcel.


Strana:  1 2   další »

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse

Ověření datumu TextBox1.Text

elninoslov • 18.10. 20:15

Auto mazanie emailov

elninoslov • 18.10. 20:01

Ověření datumu TextBox1.Text

Scraper • 18.10. 18:25

Auto mazanie emailov

Pavol1 • 18.10. 17:10

zdroj dat ve VBA

elninoslov • 18.10. 17:08

zdroj dat ve VBA

lubo • 18.10. 15:40

EXCEL VBA vyhledání buňky

lubo • 18.10. 15:39