• Úvod
• Excel návod
• Excel šablony
• Nástěnka
• Mobility
• Tipy na výlet
• Galerie
• Fórum

MS Excel

Téma: Makro - zkopírovat soubory s podmínkou

Zaslal/a kalisci 17.8.2020 10:39

Zdravím,

chtěl bych poprosit o pomoc s makrem, pomocí kterého kopíruji soubory ze složky A do složky B ...

Sub copy_data()
'Move test data to folder

Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileInFromFolder As Object

FromPath = "P:\01\" 'Source files
ToPath = "P:\02\" 'Target destination

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If

For Each FileInFromFolder In FSO.getfolder(FromPath).Files
FileInFromFolder.Copy ToPath
Next FileInFromFolder

End Sub

Potřeboval bych ale doplnit podmínku:
Pokud soubor začína číslem 0 , pak zkopíruj soubor do složky B,
pokud soubor začíná číslem 1, pak zkopíruj soubor do složky C,
pokud soubor začíná číslem 3, pak zkopíruj soubor do složky D
případně do budnoucna bude těch podmínek více...

Předem díky za pomoc

Zaslat odpověď >

---

Palooo(17.8.2020 11:13)#047694

skuste toto:

Sub copy_data()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
Dim Fdate As Date
Dim FileInFromFolder As Object
Dim aBool As Boolean

aBool = False
FromPath = ThisWorkbook.Path & "\01\" 'Source files
ToPath = ThisWorkbook.Path & "\02\" 'Target destination
Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(FromPath) = False Then aBool = True
If FSO.FolderExists(ToPath) = False Then aBool = True
If FSO.FolderExists(ToPath & "\B\") = False Then aBool = True
If FSO.FolderExists(ToPath & "\C\") = False Then aBool = True
If FSO.FolderExists(ToPath & "\D\") = False Then aBool = True
If aBool Then
MsgBox "folders doesn't exist"
Exit Sub
End If

For Each FileInFromFolder In FSO.getfolder(FromPath).Files
If Left(FileInFromFolder.Name, 1) = "0" Then FileInFromFolder.Copy ToPath & "\B\"
If Left(FileInFromFolder.Name, 1) = "1" Then FileInFromFolder.Copy ToPath & "\C\"
If Left(FileInFromFolder.Name, 1) = "3" Then FileInFromFolder.Copy ToPath & "\D\"
Next

End Subcitovat

kalisci(17.8.2020 21:10)#047703

Super, funguje to. Moc děkuju za pomoc.

Ještě možná dotaz:

Šlo by umístění těchto dvou složek načítat z listu v excelu
FromPath = ThisWorkbook.Path & "\01\" 'Source files
ToPath = ThisWorkbook.Path & "\02\" 'Target destination

Třeba z buněk A1, A2 ?citovat

Palooo(18.8.2020 8:42)#047706

ano,

FromPath = Range("A1")
ToPath = Range("A2")citovat

kalisci(18.8.2020 12:10)#047710

Děkuji za pomoc.citovat

Uživatelské menu

Nejste přihlášen(a)

• přihlásit
• registrace

\n

Menu

On-line nástroje

Formulář Faktura

Aktivní diskuse