-
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
- PlayStation 5
- Sweet.tv - internetes TV
- Futás, futópályák
- Apple asztali gépek
- (nem csak) AMD FX / Ryzen tulajok OFF topikja
- A legolcsóbb és a legdrágább új iPhone fogy a legjobban
- Battlefield 6
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- Építő/felújító topik
- Milyen billentyűzetet vegyek?
- További aktív témák...
- Samsung Galaxy S23 Ultra 5G 512GB, Kártyafüggetlen, 1 Év Garanciával
- Prémium PC házak akár 20-40% kedvezménnyel eladók garanciával, számlával! Upd. 10.22
- ÚJ Microsoft Surface Laptop 7 13.8" 2K - 120Hz Érintő - Snapdragon X Elite - 16GB - 512GB-2 év gari
- Új és újszerű 13-14 Gamer, ultrabook, üzleti, 2in1, X360, Touch készülékek kedvező áron Garanciával
- Hp Zbook 15 G5 15,6" FHD/ i7-8850H, 32GB, 512GB SSD, Quadro P2000, Magyar- Win11
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő
Fferi50
