-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
the radish
senior tag
Köszönöm!
+1:
Adott egy zip fájlt kitömörítő makró:Sub Unzip()
Dim FSO As Object
Dim oApp As Object
Dim Fname As Variant
Dim FileNameFolder As Variant
Dim DefPath As String
Fname = Application.GetOpenFilename(Filefilter:="Zip Files (*.zip), *.zip", _
MultiSelect:=False)
If Fname = False Then
'Do nothing
Else
'Destination folder
DefPath = "D:\Data\" '<<< Change path
If Right(DefPath, 1) <> "\" Then
DefPath = DefPath & "\"
End If
FileNameFolder = DefPath
' 'Delete all the files in the folder DefPath first if you want
' On Error Resume Next
' Kill DefPath & "*.*"
' On Error GoTo 0
'Extract the files into the Destination folder
Set oApp = CreateObject("Shell.Application")
oApp.Namespace(FileNameFolder).CopyHere oApp.Namespace(Fname).items
MsgBox "You find the files here: " & FileNameFolder
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
End If
End SubSzeretném a "GetOpenFilename" opciójaként megadni, hogy pl. a fájl tallózása során a "munka" elnevézű fájlokra is szűrjön, de eddig csak a fájl típus szűrést találtam.
Egy másik formációval ez sikerült, ott meg a kitömörítéssel nem jutok dülőre:
Sub OpenFileFromDefaultPath()
Dim fileDialogBox As Office.FileDialog
Dim fileName As String
Set fileDialogBox = Application.FileDialog(msoFileDialogFilePicker)
With fileDialogBox
.InitialFileName = "D:\Data\"
.InitialFileName = "*munka*"
If .Show = True Then
' e nélkül is működik
fileName = .SelectedItems(1)
End If
End With
End Sub
Új hozzászólás Aktív témák
- Hardcore café
- Sorozatok
- Samsung Galaxy Felhasználók OFF topicja
- Xiaomi 15T Pro - a téma nincs lezárva
- Építő/felújító topik
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- Szünetmentes tápegységek (UPS)
- OLED TV topic
- Folyószámla, bankszámla, bankváltás, külföldi kártyahasználat
- 50 év után kilőtt négy űrhajós a Holdra
- További aktív témák...
- Bomba ár! Lenovo ThinkPad L390 - i7-8GEN I 16GB I 256SSD I 13,3" FULL HD I HDMI I Cam I W11 I Gari!
- S21 Dobozában 128/8
- AKCIÓ! 1TB Kingston KC3000 NVMe SSD meghajtó garanciával hibátlan működéssel
- Dell Latitude 7300 Core i5-i7, 8-16GB RAM, SSD, jó akku, számla, 6 hó gar
- Eladó Realme 11 5G 8/256GB / 12 hónap jótállás
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50