Форум

Data.BG Форуми: Преместване на файлове от поддиректории и преименуването им - Data.BG Форуми

Прехвърляне към съдържание

Страница 1 от 1
  • Вие не можете да започнете нова тема
  • Вие не може да отговаряте на тази тема

Преместване на файлове от поддиректории и преименуването им Преместване на файлове от поддиректории и преименуването им

#1
Потребителят е неактивен   DrvilS 

  • Група: Потребители
  • Мнения: 52
  • Регистриран: 23-January 06
  • Репутация: 0
Здравейте,
Искам да премстя файловете от поддиректориите на една папка във нея, като ги преименувам с префикс папката в която са
Напримр имам:
А/1969/ar/1.pdf
А/1969/ar/2.pdf
А/1969/he/1.pdf
А/1969/he_2.pdf
А/1969/en/1.pdf
А/1969_en_2.pdf
А/1970/ar/1.pdf
И искам да получа:
А_1969_ar_1.pdf
А_1969_ar_2.pdf
А_1969_he_1.pdf
А_1969_he_2.pdf
А_1969_en_1.pdf
А_1969_en_2.pdf
А_1970_ar_1.pdf

Опитвам се да си напиша .bat файл, но не съм достатъчно нвътре и не се получава. Пробах и варианти с макроси през ексел, но пак не ми се получи.
http://stackoverflow...b=votes#tab-top
Ето тук правят това с изображения. При мен н работи, може би аз не правя нещо като хората. Ако някой има идеи моля да сподели.
Идеята е след определно ниво нататък да сменя наклонните черти с долни черти, за да не ми отваря папки а да ми допълва името на файла.
Приемам всякакви решения освен bulk renamer.
Благодаря!
0

#2
Потребителят е неактивен   trn 

  • Група: Потребители
  • Мнения: 1098
  • Регистриран: 30-December 04
  • Репутация: 65
  • Пол:Мъж

Преглед на мнениеDrvilS, на 17.11.15 - 17:37, каза:

Здравейте,
Искам да премстя файловете от поддиректориите на една папка във нея, като ги преименувам с префикс папката в която са
Пробах и варианти с макроси през ексел, но пак не ми се получи.

Ако това ти помогне добре
Може да ги копираш с CopyFiles
Може да ги преместваш с MoveFiles
Option Explicit
Type FoundFileInfo
    sPath As String
    sName As String
End Type
Sub CopyFiles()
 Call CopyOrMoveFiles(False)
End Sub
Sub MoveFiles()
 Call CopyOrMoveFiles(True)
End Sub
Public Sub CopyOrMoveFiles(MaskCopyMove As Boolean)
 Dim I, iFilesFound As Integer
 Dim MyDir As String
 Dim recFoundFiles() As FoundFileInfo
 Dim sFileSpec As String, FNameNoView As String
 Dim NewName As String, NewName1 As String
 Dim FSO As Object
 sFileSpec = "*.*"
 MyDir = ThisWorkbook.Path & Application.PathSeparator
 Set FSO = VBA.CreateObject("Scripting.FileSystemObject")
 If FindFiles(MyDir, recFoundFiles, iFilesFound, sFileSpec, True) Then
   For I = 1 To iFilesFound
    If recFoundFiles(I).sPath <> MyDir Then
     NewName = Replace(recFoundFiles(I).sPath, MyDir, "")
     NewName = Replace(NewName, Application.PathSeparator, "_") & recFoundFiles(I).sName
     On Error Resume Next
     Select Case MaskCopyMove
      Case False
       FSO.CopyFile recFoundFiles(I).sPath & recFoundFiles(I).sName, MyDir & NewName, True
      Case True
       FSO.MoveFile recFoundFiles(I).sPath & recFoundFiles(I).sName, MyDir & NewName
     End Select
     On Error GoTo 0
    End If
   Next
 End If
 Set FSO = Nothing
End Sub

Function FindFiles(ByVal sPath As String, _
    ByRef recFoundFiles() As FoundFileInfo, _
    ByRef iFilesFound As Integer, _
    Optional ByVal sFileSpec As String = "*.*", _
    Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean

    Dim iCount As Integer
    Dim sFileName As String
    Dim oFileSystem As Object, _
        oParentFolder As Object, _
        oFolder As Object, _
        oFile As Object
    Dim BitFile As Integer
    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set oParentFolder = oFileSystem.GetFolder(sPath)
    If oParentFolder Is Nothing Then
        FindFiles = False
        On Error GoTo 0
        Set oParentFolder = Nothing
        Set oFileSystem = Nothing
        Exit Function
    End If
    sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
    
    sFileName = Dir(sPath & sFileSpec, vbNormal)
    If sFileName <> "" Then
        For Each oFile In oParentFolder.Files
            If LCase(oFile.Name) Like LCase(sFileSpec) Then
             BitFile = oFileSystem.GetFile(sPath & oFile.Name).Attributes
             
             If isBitOn(BitFile, 2) Or isBitOn(BitFile, 4) Then
             'File is Hidden or System
             Else
              iCount = UBound(recFoundFiles)
              iCount = iCount + 1
              ReDim Preserve recFoundFiles(1 To iCount)
              With recFoundFiles(iCount)
                .sPath = sPath
                .sName = oFile.Name
              End With
             End If
            End If
        Next oFile
        Set oFile = Nothing
    End If
    If blIncludeSubFolders Then
        For Each oFolder In oParentFolder.SubFolders
            FindFiles oFolder.Path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
        Next
    End If
    FindFiles = UBound(recFoundFiles) > 0
    iFilesFound = UBound(recFoundFiles)
    On Error GoTo 0

    Set oParentFolder = Nothing
    Set oFileSystem = Nothing

End Function

Function isBitOn(ByVal Value As Integer, Bit As Byte) As Boolean
 isBitOn = (Value And Bit) > 0
End Function

1

#3
Потребителят е неактивен   DrvilS 

  • Група: Потребители
  • Мнения: 52
  • Регистриран: 23-January 06
  • Репутация: 0
Красота, благодаря много за помощта.
Опитвам да го подкарам този код но не ми е ясно как да му задам входните данни.
През какво го стартираш? Гледам че е вижуал бейсик дето се пробва за макроси в ексел. Вкарах го като макрос и сега се чудя какво да правя да тръгне.
Освен да задам пътя да е равен на някакъв input?
Извинявам се за глупавите въпроси но от скоро се опитвам да работя с макроси. Може ли малко разяснение или файл? С компилатор ли трябва да го рънна?

Мнението беше редактирано от DrvilS: 18.11.15 - 09:01

0

#4
Потребителят е неактивен   trn 

  • Група: Потребители
  • Мнения: 1098
  • Регистриран: 30-December 04
  • Репутация: 65
  • Пол:Мъж

Преглед на мнениеDrvilS, на 18.11.15 - 08:57, каза:

Красота, благодаря много за помощта.
Опитвам да го подкарам този код но не ми е ясно как да му задам входните данни.
През какво го стартираш? Гледам че е вижуал бейсик дето се пробва за макроси в ексел. Вкарах го като макрос и сега се чудя какво да правя да тръгне.
Освен да задам пътя да е равен на някакъв input?
Извинявам се за глупавите въпроси но от скоро се опитвам да работя с макроси. Може ли малко разяснение или файл? С компилатор ли трябва да го рънна?

От твоя пост съм избрал реда, в който си споменал Excel и си направих извода, че ще се справиш с него.
Това е точно за Excel.
Направил съм го по най-елементарния начин.
Директорията, в която се намира файла на Excel е главна, а поддиректориите на нея се обработват и файловете се записват в същата главна директория.
В кода има няколко макроса. За копиране се стартира макроса CopyFiles, а за преместване MoveFiles.
За всеки случай качих един xls файл /не знам с коя версия на Excel ще се работи/ с два бутона за избор тук http://www.filedropper.com/copyfiles
1

#5
Потребителят е неактивен   DrvilS 

  • Група: Потребители
  • Мнения: 52
  • Регистриран: 23-January 06
  • Репутация: 0
Работи прекрасно! Благодаря много! Машина си :8)
Искам да правя едни промени по имената на файловете, ама ще се помъча да разбера как да си го направя сам да не мрънкам и за това :)
0

#6
Потребителят е неактивен   DrvilS 

  • Група: Потребители
  • Мнения: 52
  • Регистриран: 23-January 06
  • Репутация: 0
С по-простите неща се оправих, като това да си избера пътя от InputBox и да си риплейсна някои символи в изходните файлове.
Не мога да се справя с това макроса да трие празните папки след Move. Някаква идея как да го постигна?
0

#7
Потребителят е неактивен   trn 

  • Група: Потребители
  • Мнения: 1098
  • Регистриран: 30-December 04
  • Репутация: 65
  • Пол:Мъж

Преглед на мнениеDrvilS, на 18.11.15 - 21:36, каза:

С по-простите неща се оправих, като това да си избера пътя от InputBox и да си риплейсна някои символи в изходните файлове.
Не мога да се справя с това макроса да трие празните папки след Move. Някаква идея как да го постигна?

след
   FSO.MoveFile recFoundFiles(I).sPath & recFoundFiles(I).sName, MyDir & NewName

постави това
   RmDir recFoundFiles(I).sPath

1

#8
Потребителят е неактивен   trn 

  • Група: Потребители
  • Мнения: 1098
  • Регистриран: 30-December 04
  • Репутация: 65
  • Пол:Мъж
Тук http://www.filedropp...om/copyfilesdir качих друг файл, с бутон за избор на директория за обработка.
1

#9
Потребителят е неактивен   DrvilS 

  • Група: Потребители
  • Мнения: 52
  • Регистриран: 23-January 06
  • Репутация: 0
Пробвах го и го дръпнах. Не трие празните папки. Пак си остават в основната директория. Избирам му пътя. Може би аз бъркам някъде. Сигурно нещопри мен е бъгаво. Утре сутринта ще го пробвам и с по-кадърен ексел на по кадърен комп. Благодаря отново!

Мнението беше редактирано от DrvilS: 19.11.15 - 00:12

0

#10
Потребителят е неактивен   trn 

  • Група: Потребители
  • Мнения: 1098
  • Регистриран: 30-December 04
  • Репутация: 65
  • Пол:Мъж

Преглед на мнениеDrvilS, на 18.11.15 - 23:56, каза:

Пробвах го и го дръпнах. Не трие празните папки. Пак си остават в основната директория. Избирам му пътя. Може би аз бъркам някъде. Сигурно нещопри мен е бъгаво. Утре сутринта ще го пробвам и с по-кадърен ексел на по кадърен комп. Благодаря отново!

Не ги трие защото съм допуснал грешка. Опитите, които правих бяха по случайност с копирани директории с един файл и без поддиректории. Качвам нов файл, но не можах да се преборя с един проблем. На една от директориите спира да трие, не знам по какви причини, но след натискането на втори път на бутона Move се изтрива и тази директория. Нямам време сега да проверявам защо е така. Мисля, че това ще ти свърши работа.
http://www.filedropp...opyfilesdirnews
Ако ползваш само макросите някъде другаде трябва в References да добавиш Microsoft Scripting Runtime
1

#11
Потребителят е неактивен   DrvilS 

  • Група: Потребители
  • Мнения: 52
  • Регистриран: 23-January 06
  • Репутация: 0
Пробвах някои не особено интелегентни варианти, да си сложа част от кода два пъти, за да симулирам че бутона е натиснат два пъти, но не ми се получи :D
0

#12
Потребителят е неактивен   trn 

  • Група: Потребители
  • Мнения: 1098
  • Регистриран: 30-December 04
  • Репутация: 65
  • Пол:Мъж

Преглед на мнениеDrvilS, на 21.11.15 - 13:41, каза:

Пробвах някои не особено интелегентни варианти, да си сложа част от кода два пъти, за да симулирам че бутона е натиснат два пъти, но не ми се получи :D

Това, което ще ти предложа не ми харесва, но поне ще ти свърши работа.
Процедурата MoveFiles я поправи както е тук.
Sub MoveFiles()
 Call CopyOrMoveFiles(True)
 Call CopyOrMoveFiles(True)
End Sub

1

#13
Потребителят е неактивен   DrvilS 

  • Група: Потребители
  • Мнения: 52
  • Регистриран: 23-January 06
  • Репутация: 0
Мерси! Не е най-елегантния вариант, но важното е да аботи. А работи :)
0

Споделете тази тема чрез:


Страница 1 от 1
  • Вие не можете да започнете нова тема
  • Вие не може да отговаряте на тази тема

1 потребители четат тази тема
0 регистрирани потребители, 1 гости и 0 анонимни потребители


Data.BG e форум за дискусии. Data.BG не носи отговорност за съдържанието и достоверността на публикуваните в дискусиите материали.

Никаква част от съдържанието на тази страница не може да бъде репродуцирана, записвана или предавана под каквато и да е форма или по какъвто и да е повод без писменото съгласие на Data.BG.

Close  Member Login