< návrat zpět

MS Excel

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

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
avatar
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
avatar
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
avatar
ano,

FromPath = Range("A1")
ToPath = Range("A2")citovat
kalisci(18.8.2020 12:10)#047710
avatar
Děkuji za pomoc.citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Helios iNuvio

Používáte podnikový systém Helios iNuvio? Potřebujete pomoci se správou nebo vyvinout SQL proceduru? Více informací naleznete na stránce Helios iNuvio.

On-line nástroje