VBA pdf fájlok másolása több mappából egy mappába.

VBA pdf fájlok másolása több mappából egy mappába.
2020-01-25T00:29:44+01:00
2020-01-28T19:51:36+01:00
2022-10-15T21:26:04+02:00
Kornél32
Sziasztok!

Pdf fájlok másolásával gyűlött meg a bajom.
Van 12 mappám (hónapokat jelölnek) Az aktuális hónapban napi 10-20 pdf. fájlal bővül a mappa.
Ezeket a különálló mappákat szeretném egy közös mappába másolni. Ez most jelenelg 3-4 ezer fájl. Ami 5-6 perces futtatást jelent. Ezt szeretném csökkenteni.

A ki induló képlet: (Másolja a fájlokat. Következő futtatásnál a már másolt fájlokat kihagyja.)

Dim MyFSO As FileSystemObject Dim MyFile As File Dim SourceFolder As String Dim DestinationFolder As String Dim MyFolder As Folder Dim MySubFolder As Folder SourceFolder = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.01" DestinationFolder = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.00" Set MyFSO = New Scripting.FileSystemObject Set MyFolder = MyFSO.GetFolder(SourceFolder) For Each MyFile In MyFolder.Files MyFSO.CopyFile Source:=MyFSO.GetFile(MyFile), _ Destination:=DestinationFolder & "" & MyFile.Name, Overwritefiles:=True Next MyFile Ebből a képletből így sikerült elérnem, hogy minden hónapot másoljon. Dim MyFSO As FileSystemObject Dim MyFile As File Dim SourceFolder As String Dim DestinationFolder As String Dim MyFolder As Folder Dim MySubFolder As Folder SourceFolder = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.01" DestinationFolder = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.00" Set MyFSO = New Scripting.FileSystemObject Set MyFolder = MyFSO.GetFolder(SourceFolder) For Each MyFile In MyFolder.Files MyFSO.CopyFile Source:=MyFSO.GetFile(MyFile), _ Destination:=DestinationFolder & "" & MyFile.Name, Overwritefiles:=True Next MyFile SourceFolder = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.02" DestinationFolder = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.00" Set MyFSO = New Scripting.FileSystemObject Set MyFolder = MyFSO.GetFolder(SourceFolder) For Each MyFile In MyFolder.Files MyFSO.CopyFile Source:=MyFSO.GetFile(MyFile), _ Destination:=DestinationFolder & "" & MyFile.Name, Overwritefiles:=True Next MyFile ... és másolva 12. mappáig. Ennél is van jobb megoldás biztosan. Ennél egyszerűbbnek tűnik, ha az utolsó mappától visszafelé keressi az első megegyező fájlt. És amit közben talál azt másolja. Viszont fogalmam sincs hogyan álljak neki. Ehhez kérném a segítségeteket. Amit előre is köszönök.
Mutasd a teljes hozzászólást!
Szia!
Amennyiben a folderek elnevezése a példád szerinti, akkor FOR  -  NEXT ciklussal lehet a forrásfolderek nevét megadni.
Ezután nem kell újra és újra megkreálni a MyFSO objektumot (megjegyzem, ezt ebben a felállásban sem kellene), csak használni. Ugyanígy nem szükséges a célmappát megadni ismételten, hiszen az mindig azonos.

Dim x As Byte Dim SourceF as String Set MyFSO = New Scripting.FileSystemObject SourceF= "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019." DestinationFolder = "X:\Production\Production TIE\08 Kaizen team\01KAIZEN ÖSSZESÍTŐ\2019\Kaizen ig. fotók 2019\2019.00" For x =1 to 12 SourceFolder = SourceF & Right("0" & x ,2) Set MyFolder = MyFSO.GetFolder(SourceFolder) For Each MyFile In MyFolder.Files MyFSO.CopyFile Source:=MyFSO.GetFile(MyFile), _ Destination:=DestinationFolder & "" & MyFile.Name, Overwritefiles:=True Next MyFile Next x
Persze az elején a Dimeket ne hagyd le.
Sajnos ettől a futásidő még nem feltétlenül fog rövidülni.
Üdv.
Mutasd a teljes hozzászólást!

Tetszett amit olvastál? Szeretnél a jövőben is értesülni a hasonló érdekességekről?
abcd