Hirdetés

Keresés

Új hozzászólás Aktív témák

  • the radish

    senior tag

    válasz lappy #49884 üzenetére

    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 Sub

    Szeretné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