Aktív témák
-
Sziasztok!
Egy kis segítséget kérek.
Összeállítottam egy telepítő DVD-t magamnak.
Ehhez szeretnék írni egy scriptet, amit autorunnal indítok. A script mindössze annyit csinál, hogy felugrik egy ablak, benne 3-4 nyomógomb.
Ha az 1-es gombra kattintok akkor az 1-es telepítő indul el, ha a 2-es gombra akkor a kettes telepítő stb.Ennyit tudtam eddig megcsinálni ,de ez kevés, mert nem történik semmi, nem jelenik meg az ablak. Gondolom hiányzik az ablak kezelés. (A baj, hogy nem értek a vbscripthez)
Mit kellene az elejére írnom?Private Sub telepito_1()
Shell "setup1.exe", vbNormalFocus
End SubPrivate Sub telepito_2()
Shell "setup2.exe", vbNormalFocus
End SubPrivate Sub telepito_3()
Shell "setup3.exe", vbNormalFocus
End Sub -
Köszönöm a segítségedet kraftxld.
Sikerült VBscripttel megoldani.

-
Alakul. Még a kimenetet kellene formázni, mert jelenleg az első cellába a teljes elérési utat rakja be, így:
_______________________________
|c:\teszt\könyvtár1\alkönyvtár1\ | fájl1 |
------------------------------------------------------
|c:\teszt\könyvtár1\alkönyvtár2\ | fájl1 |
------------------------------------------------------
|c:\teszt\könyvtár2\alkönyvtár1\ | fájl1 |
------------------------------------------------------Ez még nem igazán jó. A c:\teszt rész pl nem kell. Hogy tudom azt megcsinálni, hogy a "\" legyen egy határoló és az így kapott mezők közül az első cellába rakja a 2. mezőt?
Linux alatt van a cut parancs amivel ezt szépen meg lehet csinálni, de nekem windows alatt kell.
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
intRow = 2
objExcel.Cells(1, 1).Value = "Folder"
objExcel.Cells(1, 2).Value = "File Name"
Set objFSO = CreateObject("Scripting.FileSystemObject")
sfolder="\"
ShowSubfolders objFSO.GetFolder(sfolder)
Sub ShowSubFolders(Folder)
For Each Subfolder in Folder.SubFolders
objExcel.Cells(intRow, 1).Value = Subfolder.Path
Set objFolder = objFSO.GetFolder(Subfolder.Path)
Set colFiles = objFolder.Files
For Each objFile in colFiles
objExcel.Cells(intRow, 2).Value = objFile.Name
intRow = intRow + 1
Next
ShowSubFolders Subfolder
Next
End Sub
objExcel.Range("A1:B1").Select
objExcel.Selection.Interior.ColorIndex = 19
objExcel.Selection.Font.ColorIndex = 11
objExcel.Selection.Font.Bold = True
objExcel.Cells.EntireColumn.AutoFit
MsgBox "Kész vagyok." -
Az a baj, hogy nekem pont az kellene, hogy kb 10-15 gépről elérjék a scriptet.
Gyakorlatilag egy könyvtár struktúrát töltenek fel fileokkkal, és kell egy összesítő excel.Ezt úgy a legegyszerűbb, ha írok egy scriptet, ami a lefut, és generál egy egy excel táblát, így nem kell folyamatosan kézzel update-elni a a tábázatot, és nem kell foglalkozni azzal sem, hogy ki nyitotta meg írásra a filet, ki csak olvasásra.
Ezért gondoltam VBscriptre, mert az az összes XP-s gépen lefut, különösebb előfeltétel nélkül.
-
Üdv
Egy kis segítséget szeretnék kérni a munkám egyszerűsítéséhez.
Adott egy ilyen könyvtár struktúra:
-könyvtár1
---alkönyvtár1
-----------------file1
-----------------file2
---alkönyvtár2
-----------------file1
-----------------file2
-könyvtár2
---alkönyvtár1
-----------------file1
-----------------file2
---alkönyvtár2
-----------------file1
-----------------file2Ezt szeretném excelbe listázni, valahogy így:
_______________________
|könyvtár1 | alkönyvtár1 | file1 |
----------------------------------------
|könyvtár1 | alkönyvtár1 | file2 |
----------------------------------------
|könyvtár1 | alkönyvtár2 | file1 |
----------------------------------------
|könyvtár1 | alkönyvtár2 | file2 |
----------------------------------------
|könyvtár2 | alkönyvtár1 | file1 |
----------------------------------------
|könyvtár2 | alkönyvtár1 | file2 |
----------------------------------------
|könyvtár2 | alkönyvtár2 | file1 |
----------------------------------------
|könyvtár2 | alkönyvtár2 | file2 |
----------------------------------------Nem tudok VBScriptben programozni, ezt a google-val vadásztam össze.
A scriptben eddig jutottam, de ez még kevés, mert ez csak azokat a fileokat listázza ki, ami a "gyökér" könyvtárban vannak:Dim fso, objFolder, obFileList, folderpath, fullpath, i, objExcel 'változók
folderpath = "\" 'forrás könyvtár
Set fso = CreateObject("Scripting.FileSystemObject") 'ezt nem tudom mi
Set objFolder = fso.GetFolder(folderpath) 'forrás könyvtár bekérése
Set objSubfolder = objFolder.Subfolders 'alkönyvtárak az objSubfolderhez rendelése
Set objFileLista = objFolder.Files 'forrás könyvtár fájljainak objFileList-hez rendelése
' Excel megnyitása
Set objExcel = createobject("Excel.application")
objexcel.Workbooks.add
' fejléc létrehozása
i=1
objexcel.Cells(1, 1).Value = "konyvtár" '1 első sor 1 cella megnevezése
objexcel.Cells(1, 2).Value = "alkönyvtár" '1 első sor 2 cella megnevezése
objexcel.Cells(1, 3).Value = "fájl neve" '1 első sor 3 cella megnevezése
objexcel.Visible = True
' adatok feltöltése
i=2
For Each File In objFileLista
fullpath = folderpath & "\" & file.name
objexcel.Cells(i, 1).value = file.name 'i első sor 1 cella
objexcel.Cells(i, 2).value = objSubfolder 'i első sor 2 cella
objexcel.Cells(i, 3).value = objSubfolder 'i első sor 3 cella
i = i + 1
Next
MsgBox "Kész vagyok."
objExcel.DisplayAlerts = FALSEHogy tudom a könyvtár és alkönyvtár neveket bepakolni a cellákba? Nekem csak az alkönyvtárak tartalmát kellene kilistázni, azt hogy tudom kiírni?
Aktív témák
- Gamer PC / i3-12100F / Asus Prime H620M-K / GeForce RTX 3050 8GB / 8GB DDR4 RAM
- SAPPHIRE RX 7800 XT 16GB GDDR6 NITRO+ - Új, 1 év garancia - Eladó!
- Dell Pro 14 Plus PB14250 14" FHD+ IPS Ultra 5 235U 16GB 256GB NVMe ujjlolv gar
- ASUS RTX 3070 8GB GDDR6 TURBO - Új, 1 év garancia - Eladó!
- Gigabyte GAMER-ke FullHD IPS Core i7(8 3,4Ghz),GTX 2/6GB DDR5 128BIT VGA,16GB RAM/560GB-1TB SSD
- Lenovo Thinkpad E595 Ryzen 5 3500U, Radeon Vega 8, 8-16GB RAM, SSD, jó akku, számla, gar
- Apple iMac 27" 5K 2015 Late / 16GB DDR3 / 512 GB SSD / Bill+Egér 6 hó garancia, számlával!
- Xiaomi Redmi Note 12 Pro 5G, Kártyafüggetlen, 1 Év Garanciával
- AKCIÓS ! MacBook Pro 16" M1 Pro 16GB RAM 512GB SSD! 1 év garancia!
- BESZÁMÍTÁS! Gigabyte H610M i5 13600KF 16GB DDR4 500GB SSD RTX 3060Ti 8GB RAMPAGE Shiva CM 700W
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

