Hirdetés
- Samsung Galaxy S23 Ultra - non plus ultra
- Külföldi prepaid SIM-ek itthon
- Samsung Galaxy Watch6 Classic - tekerd!
- Azonnali mobilos kérdések órája
- Samsung Galaxy Fit 3 - keveset, de jól
- A piac legerősebb kameráját ígéri a Xiaomi 17 Ultra
- Itthon is elérhető a OnePlus 11 és a Buds Pro 2
- Prohardver app (nem hivatalos)
- Xiaomi 15T Pro - a téma nincs lezárva
- Samsung Galaxy Ring - gyűrű-kúra
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
- Inno3D GeForce RTX 4070 Ti X3 12G - Karácsonyi akcióban!
- Redragon Kumara K552 RGB Brown Switch magyar billentyűzet
- Lenovo Thinkpad P1 Gen 6 - i9-13980HX, 32GB, 2TB SSD, 16" WQUXGA (3840 2400), RTX 4090
- 15.gen! Intel Core Ultra 9 285K +16-32GB DDR5 RAM +hűtött VRM-es Z890 lap! GAR/SZÁMLA (a Te nevedre)
- OP AudioCodes C450HD Ip Phones - Szines kijelzős - Teams/ Zoom telefon - Új dobozos
- GYÖNYÖRŰ iPhone 13 mini 128GB Blue -1 ÉV GARANCIA - Kártyafüggetlen, MS3293
- Vállalom telefonok,tabletek javítását ,(szoftveres hibát is,frp lock-ot is)márkától fügetlenűl
- BESZÁMÍTÁS! ASUS B150M i5 6402P 8GB DDR4 500GB SSD GTX 1050 Ti 4GB Rampage SHIVA DeepCool 400W
- BESZÁMÍTÁS! MSI B450M R5 5600X 32GB DDR4 512GB SSD RTX 3070 Ti 8GB Zalman S2 TG GIGABYTE 750W
- Asus ROG Strix Scope Deluxe /DE/Red switch/
Állásajánlatok
Cég: Laptopszaki Kft.
Város: Budapest
Cég: BroadBit Hungary Kft.
Város: Budakeszi



