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

  • Fferi50

    őstag

    válasz pirit28 #24897 üzenetére

    Szia!

    Bocs a hosszú hallgatás miatt! Remélem, még aktuális. Próbáld meg ezt:
    Sub okesit()
    Do
    With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = CurDir()
    If .Show Then
    okesito .SelectedItems(1), True
    Else
    If MsgBox("Nem választottál, befejezed?", vbYesNo, "Könyvtár választás") = vbYes Then Exit Sub
    End If
    End With
    Loop
    End Sub
    Sub okesito(ByVal konyvtar As String, ByVal alkonyvtaris As Boolean)
    Dim fs, fldr, subfldr, fld, fajl As String
    Set fs = CreateObject("Scripting.FilesystemObject")
    Set fldr = fs.GetFolder(konyvtar)
    fajl = Dir(fldr & "\*.xls*")
    Do While fajl <> ""
    Workbooks.OpenText Filename:=fldr & "\" & fajl
    ActiveWorkbook.SaveAs Filename:=Replace(ActiveWorkbook.FullName, ".xls", "ok.xls")
    'MsgBox fajl
    fajl = Dir()
    Loop
    If alkonyvtaris Then
    Set subfldr = fldr.subfolders
    For Each fld In subfldr
    fajl = Dir(fld & "\*.xls*")
    Do While fajl <> ""
    Workbooks.OpenText Filename:=fld & "\" & fajl
    ActiveWorkbook.SaveAs Filename:=Replace(ActiveWorkbook.FullName, ".xls", "ok.xls")
    'MsgBox fajl
    fajl = Dir()
    Loop
    Next
    End If
    End Sub

    Az okesit makrót kell elindítani, ott ki tudod választani azt a könyvtárat, amelyben (és alkönyvtáraiban) végre szeretnéd hajtani a műveletet.
    Ha a kiválasztott könyvtárban elvégzi a műveletet, akkor visszatér a választó ablak.
    A makróból úgy léphetsz ki, hogy a mégse gombot választod, vagy esc-t nyomsz és a kérdésre igent válaszolsz.
    Az előrehaladásra nem tettem bele információ kijelzést, a státuszsoron esetleg kiírathatod pl. a kikommentelt msgbox helyére, Application.StatusBar = fajl
    akkor a végére pedig Application.StatusBar=False

    Üdv.

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