Kopiranje celotne mape z datotekami

Pomoč pri izdelavi makrov
Odgovori
Stenly
Prispevkov: 223
Pridružen: Sr Jul 27, 2005 11:29 pm

Kopiranje celotne mape z datotekami

Odgovor Napisal/-a Stenly »

Pozdravljeni

Že kar nekaj ur se mučim, pa ne gre :( .
Rad bi prekopiral mapo z več datotekami iz ene lokacije na drugo.

Lp
admin
Site Admin
Prispevkov: 3687
Pridružen: Sr Jul 20, 2005 10:06 pm

Odgovor Napisal/-a admin »

Pozdravljeni,

Prilagam vam kodo, ki jo je zapisal Bob Philips, jaz pa sem jo malce priredil za vaš problem

Koda: Izberi vse

Dim FSO As Object

Sub KopirajMapo()
  Dim i As Long
  Dim sFolder As String
  Dim sSource As String
  Dim sTarget As String

  sSource = "C:\MyTest"
  sTarget = "C:\NewDir"

  Set FSO = CreateObject("Scripting.FileSystemObject")

  On Error Resume Next
  If FSO.GetFolder(sTarget) Is Nothing Then
    MkDir sTarget
  End If
  On Error GoTo 0

  KopirajDatoteke sSource, sTarget
End Sub

Sub KopirajDatoteke(ByVal Source As String, ByVal Target As String)
  Dim oFldr As Object
  Dim oFolder As Object
  Dim oFile As Object
  Dim oFiles As Object
  Dim sTarget As String

  Set oFolder = FSO.GetFolder(Source)
  If InStr(4, oFolder.Path, "\") = 0 Then
    sTarget = Target
  Else
    sTarget = Target & Mid(Source, InStr(4, oFolder.Path, "\"), 255)
  End If

  On Error Resume Next
  If FSO.GetFolder(sTarget) Is Nothing Then
    MkDir sTarget
  End If
  On Error GoTo 0
  
  Set oFolder = FSO.GetFolder(Source)
  Set oFiles = oFolder.Files
  For Each oFile In oFiles
    oFile.Copy (sTarget & "\" & oFile.Name)
  Next oFile

  For Each oFldr In oFolder.Subfolders
    CopyFiles oFldr.Path, Target
  Next
End Sub
Pred zagonom seveda usrezno popravite sSource (izvorna mapa) in sTarget (ponorna mapa).
lp,
Matjaž Prtenjak
Administrator
Stenly
Prispevkov: 223
Pridružen: Sr Jul 27, 2005 11:29 pm

Odgovor Napisal/-a Stenly »

:!: ... je res bolj zapleteno, kot pa sem mislil jaz.
Hvala za kodo in lp.
Odgovori