Tenho um código para recortar imagens de uma pasta (Origem), criar pastas (Sequencialmente) e Colar nas pastas recém criadas (Destino) com uma quantidade determinada por um TextBox.
Porém não está criando as pastas, apenas criar a primeira pasta, recorta e cola as imagens.
Código: Selecionar todos
Private Sub btGerarPastas_Click()
Dim sourceFolder As String
Dim targetFolder As String
Dim imageCount As Integer
Dim currentCount As Integer
Dim sourceFile As String
Dim targetFile As String
Dim folderNumber As Integer
'Defina a pasta de origem das imagens'
sourceFolder = "C:\SERVICO\Projetos VB\IMAGEM\ORIGEM\"
'Defina a pasta de destino para salvar as imagens recortadas'
targetFolder = "C:\SERVICO\Projetos VB\IMAGEM\DESTINO\"
'Obtenha o valor digitado pelo usuário no TextBox'
imageCount = Val(txtQuantidade.Text)
'Verifique se o valor digitado é válido'
If imageCount <= 0 Then
MsgBox "Digite um valor válido.", vbExclamation, "Quantidade inválida"
Exit Sub
End If
'Crie a nova pasta de destino, caso ela ainda não exista'
If Dir(targetFolder, vbDirectory) = "" Then
MkDir targetFolder
End If
'Corte as imagens da pasta de origem e cole na pasta de destino'
currentCount = 0
folderNumber = 1
Do While True
'Crie uma nova pasta para as próximas imagens'
MkDir targetFolder & "Pasta" & folderNumber
'Copie as imagens para a nova pasta'
sourceFile = Dir(sourceFolder & "*.jpg")
Do While sourceFile <> ""
currentCount = currentCount + 1
If currentCount > imageCount Then
Exit Sub
End If
targetFile = targetFolder & "Pasta" & folderNumber & "\" & sourceFile
Name sourceFolder & sourceFile As targetFile
sourceFile = Dir()
Loop
'Verifique se ainda há mais imagens na pasta de origem'
If Dir(sourceFolder & "*.jpg") = "" Then
Exit Do
End If
folderNumber = folderNumber + 1
Loop
'Exiba uma mensagem de conclusão'
MsgBox "Foram cortadas " & currentCount & " imagens em " & folderNumber - 1 & " pastas dentro de " & targetFolder, vbInformation, "Concluído"
End Sub
Também terá um outro TextBox (txtLote) onde determino a sequência inicial de Lote/Pasta até o fim das imagens.
Ex.: txtCaixa = 001
txtLote = 00001
txtQuantidade = 5
Então irá na Pasta de Origem - Caixa/Pasta (CX001) irá recortar a primeiras 5 imagens e colar na Pasta recém criada da Pasta de Destino - Lote/Pasta (Lote00001) e assim por diante...Lote00002 colar as próximas 5 imagens...Lote00003 próximas 5,...!
Poderiam me auxiliar nesse código !?
Att,
Francisco