-
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
- Telefon felvásárlás!! iPhone 11/iPhone 11 Pro/iPhone 11 Pro Max
- BESZÁMÍTÁS! ASUS B660M i5 12400F 16GB DDR4 1TB SSD RTX 3070 8GB Zalman T4 Plus Cooler Master 750W
- Hp Zbook 15 G5 15,6" FHD/ i7-8850H, 32GB, 512GB SSD, Quadro P2000, Magyar- Win11
- Samsung Galaxy Z Fold4 Graygreen Duplakijelzős produktivitás, 120 Hz, Garancia 2026. 03. 22-ig
- Acer TravelMate P214 i3-1115G4 16GB 512GB 14" FHD 1év garancia
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő
Fferi50
