Telefonszámunk: 1-472-0679

[Resolved] Fájlok másolása több különböző mappába

Kezdőlap › Fórumok › Excel programozás › [Resolved] Fájlok másolása több különböző mappába

Topic Resolution: Resolved
9 bejegyzés megtekintése - 1-9 / 9
  • Szerző
    Bejegyzés
  • 2025-02-16-13:12 #11285
    jonovi
    Felhasználó

      Sziasztok!
      Az alábbiakhoz szeretném kérni a segítségeteket.

      Fájlokat (Excel, PDF, stb.) kellene másolnom egy adott mappa szerkezetből, egy másik mappa szerkezetbe.

      Például innen: „E:\Minta cég\Nyilvántartások\2024\Havi nyilvántartás_2024 01.xlsx”
      ide: „E:\Minta cég\Minta cég 2024\2024. I. negyedév\2024 01\Nyilvántartás\Havi nyilvántartás_2024 01.xlsx”

      Ez csak egy részlet, mert sokkal több mappa van, alkalmanként sok kereséssel és fájlokkal.
      Az alapelképzelésem az lenne, hogy a Total Commandert segítségül hívva, listáznám a fájl neveket és elérési útjaikat egy táblázatban és ezek mellé már hatékonyabban tudnám megadni a cél mappát, mint egyesével a T C-ben átmásolgatni őket.

      Fontosnak tartom leírni, hogy ugyan készítettem már kisebb makrókat, kódrészleteket, de ezeket innen-onnan összeszedve, egyik sem a saját ötletem, talán némelyiket nem is biztos, hogy jól értem, miért működik.

      Az még egy igazán hatalmas eredmény lenne, ha a mappákat is elkészíthetném.
      Most van egy mappa készítő kódrészletem, ami működik is, de ezzel nem tudok további mappaszerkezetet létrehozni egy lépésben a megadott mappába:

      Sub Create_Multiple_Folder()

      Dim sh As Worksheet

      Set sh = ThisWorkbook.Sheets(„Sheet1”)

      Dim sub_folder_path As String

      Dim i As Integer

      For i = 4 To sh.Range(„A” & Application.Rows.Count).End(xlUp).Row

      sub_folder_path = sh.Range(„C1”).Value & Application.PathSeparator & sh.Range(„A” & i).Value

      If Dir(sub_folder_path, vbDirectory) = „” Then

      MkDir (sub_folder_path)

      sh.Range(„B” & i).Value = „Folder Created”

      Else

      sh.Range(„B” & i).Value = „Folder already available”

      End If

      Next i

      End Sub

      Ha hatalmas sületlenségeket írtam, akkor mindenkitől elnézést és tekintsétek tárgytalanak azt rész vagy az egészet.
      Köszönettel,
      Józsi

      2025-02-16-13:15 #11286
      jonovi
      Felhasználó

        Bocsánat, most látom, hogy sikerült a nyelvtant is átalakítanom, pl.: mappa szerkezet = mappaszerkezet

        2025-02-16-15:09 #11287
        delila
        Felhasználó

          Szia!

          Egy mód a mentendő mappa helyének kiválasztásához:

          Sub konyvtarvalaszt()
  Dim konyvtar As String
  With Application.FileDialog(msoFileDialogFolderPicker)
     If .Show Then
         konyvtar = .SelectedItems(1)
         MsgBox konyvtar
     Else
        MsgBox "Nem választottál"
     End If
  End With
End Sub

          Üdv,
          Delila

          2025-02-16-17:45 #11288
          jonovi
          Felhasználó

            Szia Delila!

            Nagyon szépen köszönöm.
            Remekül működik ez.

            A fájlok másolására is szedtem már össze dolgokat, de még nem az igazi:

            „B1 cellában van a képek elérési útja, D1 cellában a célmappa
            B4 cellától kezdődnek azok a fájlnevek, amiket át kell másolni a célmappába.
            Ha nem talál fájlt a forrás mappában, akkor a C oszlopba „Copy error …” szöveggel jelzi.”

            A fenti leírás van az alábbi kódrészlethez.
            Azonban nekem ezt úgy kellene megváltoztatnom, hogy a B oszlopban a B2 cellától lennének egymás alatt a mellette lévő C oszlop azonos sorában a fájlnevek, amiket a D oszlop azonos sorában lévő célmappákba kellene átmásolni.

            Ha valaki tudna esetleg segíteni ebben.

            Sub CopyFile()
            Dim src As String, dst As String, fl As String, Dim x As Integer
            ‘Source directory
            src = Range(„B1”)
            ‘Destination directory
            dst = Range(„D1”)
            ‘File name
            x = 4
            Do
            fl = Range(„B” & x).Value
            On Error Resume Next
            FileCopy src & „” & fl, dst & „” & fl
            If Err.Number <> 0 Then
            Range(„C” & x).Value = „Copy error: ” & src & ” ” & fl
            End If
            On Error GoTo 0
            x = x + 1
            Loop While Not IsEmpty(Range(„B” & x))

            End Sub

            Köszönettel,
            Józsi

            2025-02-16-17:48 #11289
            jonovi
            Felhasználó

              Bocsánat, helyesen így nézne ki a fenti kódhoz a kérésem:

              Azonban nekem ezt úgy kellene megváltoztatnom, hogy a B oszlopban a B2 cellától lennének egymás alatt a fájlok elérési útja, a mellette lévő C oszlop azonos sorában a fájlnevek, amiket a D oszlop azonos sorában lévő célmappákba kellene átmásolni.

              2025-02-16-18:14 #11290
              eNFeri
              Felhasználó

                Szia jonovi
                Nem nagyon értem a feladatot, meg hogy milyen logika alapján csinálod meg az új könyvtárszerkezetet, de azért én is leírom, amit gondolok.
                Nem értek a makróhoz, és szerintem nem is kell ehez a feladathoz.
                TC Kijelölés -> Nevek másolása útvonallal együtt a vágólapra. (Az összes filet)
                Beillesztés egy táblázat „B” oszlopába.
                „C” oszlopba az új könyvtárszerkezt filenévvel.
                „A” oszlopba a COPY szó.
                Ezt elmented egy CSV fileba, a <TAB>-okat kicseréled <szóköz>-re, és átnevezed a kiterjesztést .BAT-ra. Lefuttatva ármásolja a fileokat az új helyre.

                De még előtte a könyvtárakat is létre kell hozni, ahoz meg az „MKDIR” parancsot kell használni COPY helyett.

                A könyvtár és a filenév egyesítését pedig az „ÖSSZEFŰZ” paranccsal csinálnám.

                2025-02-16-19:29 #11291
                jonovi
                Felhasználó

                  Szia eNFeri
                  Sajnos egy alacsony tudáskészlettel a témában, megspékelve internetes keresgélés alapján alakult ki ez a koncepció (makró).
                  Szerintem a lényeget megkaptam tőled, mert fájlokat kell másolnom.
                  Nagyon szépen köszönöm.
                  Zseniálisnak tűnik, már csak az a kérdés, hogy meg tudom-e valósítani, azt hiszem ez már csak rajtam fog múlni 🙂
                  Lenne egy biztonsági kérdésem, még ha nagyon ciki is, pedig a neten is kerestem mielőtt most felteszem részedre.
                  A <TAB>-ok az egyenlő a pontosvesszővel? Tényleg szégyellem, de nem vagyok biztos benne.
                  Pedig egy minta fájlt is elkészítettem, hátha felfogom.

                  Illetőleg a könyvtár létrehozását jól értem-e?
                  Például:
                  Az „A1” cellába „MKDIR”, a „B1” cellába e:\Munka\Minta cég\2024 01\Nyilvántartás
                  Az „A2” cellába „MKDIR”, a „B2” cellába e:\Munka\Minta cég\2024 01\Visszaigazolás
                  stb.
                  Utána már megegyezik azzal a résszel, hogy mentés CSV fileba …..

                  Köszönettel,
                  Józsi

                  2025-02-16-19:38 #11292
                  jonovi
                  Felhasználó

                    Ja és az új könyvtárszerkezet, hát ezt én sem értem, de a főnököm kiadta, már legalább egy hónapja vívok vele, hogy ennek semmi értelme, de úgy érzem annál inkább ezt akarja
                    Minden hónapban átadom ezeket az adatok, de most még így is szeretné látni, pedig archiválásra mennek ezek, talán a kutya sem fogja megnyitni
                    Ráadásul most javasoltam neki, hogy akkor így adnám át minden hónapban, erre mit mondott ez a drága jóember, ja ez így túl bonyolult lenne neki havonta
                    El is gondolkodtam, talán nem jó helyen vagyok 🙂

                    2025-02-17-00:27 #11293
                    jonovi
                    Felhasználó

                      Szia eNFeri,
                      ezzel (.bat) a technikával nem sikerült megoldanom.
                      Azonban a következővel már egy kis teszt is lefutott:

                      Sub VBACopyFilesInList()

                      ‘Declare variables
                      Dim copyFromFileRange As Range
                      Dim copyToFileRange As Range
                      Dim i As Long
                      Dim j As Long

                      ‘Turn off error checking
                      On Error Resume Next

                      ‘Get ranges
                      Set copyFromFileRange = Application.InputBox( _
                      Title:=”Select range”, _
                      Prompt:=”List of files to copy:”, _
                      Type:=8)
                      If copyFromFileRange Is Nothing Then Exit Sub

                      Set copyToFileRange = Application.InputBox( _
                      Title:=”Select range”, _
                      Prompt:=”List of file destinations:”, _
                      Type:=8)
                      If copyToFileRange Is Nothing Then Exit Sub

                      ‘Loop through rows
                      For i = 1 To copyFromFileRange.Rows.Count

                      ‘Loop through columns
                      For j = 1 To copyToFileRange.Columns.Count

                      FileCopy copyFromFileRange.Cells(i, j), _
                      copyToFileRange.Cells(i, j)

                      Next j

                      Next i

                      ‘Turn error checking back on
                      On Error GoTo 0

                      End Sub

                      Köszönettel,
                      Józsi

                    • Szerző
                      Bejegyzés
                    9 bejegyzés megtekintése - 1-9 / 9
                    • Be kell jelentkezni a hozzászóláshoz.