Estou usando o código abaixo para copiar X arquivos para Y lugares diferentes, porém devido a alteração para funcionar em várias células parou a função de 'criar pasta' caso o caminho não exista, agora a única coisa que cria é um arquivo sem extensão com
o nome como se fosse o nome da pasta:
Alguém sabe como faço para criar uma pasta caso ela não exista dentro da VBA abaixo?
Option Explicit
Public Declare Function SHFileOperation Lib "shell32.dll" _
Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) _
As Long
Public Const FO_COPY As Long = &H2
Public Const FOF_ALLOWUNDO As Long = &H40
Public Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type
Public Sub CopiarArq(Origem As String, Destino As String)
Dim RST As Long
Dim FLOP As SHFILEOPSTRUCT
FLOP.hWnd = 0
FLOP.wFunc = FO_COPY
FLOP.pFrom = Origem & vbNullChar & vbNullChar
FLOP.pTo = Destino & vbNullChar & vbNullChar
FLOP.fFlags = FOF_ALLOWUNDO
RST = SHFileOperation(FLOP)
If RST <> 0 Then
MsgBox Err.LastDllError, vbCritical Or vbOKOnly
Else
If FLOP.fAnyOperationsAborted <> 0 Then
MsgBox "Falha na cópia!!!", vbCritical Or vbOKOnly
End If
End If
End Sub
Sub Copiar()
Dim x As Integer
'loop pelas linhas a serem copiadas
For x = 1 To 100
CopiarArq Range("h" & x).Value, Range("I" & x).Value
Next
End Sub
