COPIAR TODOS OS ARQUIVO MENOS UMA EXTENSAO

SPIDERMANSV 01/07/2010 10:08:55
#346226

Ola galera vamos ver se voces conseguem me ajudar!!

Tenho uma aplicacao que copia todos os arquivos de uma pendrive para uma pasta especifica da rede, ate ai blz consegui fazer funcionar. Porem me surgiu uma duvida gostaria de copiar todos os arquivos menos uma extensao especifica. Pois nao adianta eu copiar e excluir depois pois os arquivos sao muito grandes.

Segue meu Codigo:

Dim result As Long, fileop As SHFILEOPSTRUCT
Dim x As Integer
Dim DestinoFim As String
Dim path, pasta
Dim fso As FileSystemObject
Set fso = CreateObject([Ô]Scripting.FileSystemObject[Ô])

On Error Resume Next

If QtdFitas > 1 Then

For x = 1 To QtdFitas
With fileop
.hwnd = Me.hwnd
.wFunc = FO_COPY
If x = 1 Then
.pFrom = Origem & [Ô]*.*[Ô] & vbNullChar & vbNullChar [txt-color=#e80000] teria que mudar alguma coisa nessa linha [/txt-color]
DestinoFim = Destino & retranca
MkDir DestinoFim
DestinoFim = Destino & retranca & [Ô]\XDCAM00[Ô] & x
MkDir DestinoFim
.pTo = DestinoFim [ô]& vbNullChar & vbNullChar
Else
frmInputbox.Label1.Caption = [Ô]INSIRA O PRÓXIMO DISCO - Nº 0[Ô] & x
frmInputbox.Caption = [Ô]Insira Próximo Disco[Ô]
frmInputbox.resposta.Visible = False
frmInputbox.btnresposta.Left = 3340
frmInputbox.btnresposta.Top = 840
frmInputbox.Show 1
[ô].pFrom = Origem & [Ô]Sub[Ô] & vbNullChar [ô]& vbNullChar
.pFrom = Origem & [Ô]*.*[Ô] & vbNullChar [ô]& vbNullChar
DestinoFim = Destino & retranca & [Ô]\XDCAM00[Ô] & x
MkDir DestinoFim
.pTo = DestinoFim [ô]& vbNullChar & vbNullChar
End If
[ô].fFlags = FOF_SIMPLEPROGRESS Or FOF_FILESONLY [ô] copia soh arquivos
.fFlags = FOF_ALLOWUNDO [ô]copia arquivos e pastas tudo que tiver dentro
End With
result = SHFileOperation(fileop)
[ô]Kill DestinoFim & [Ô]\Sub\*.xml[Ô]
Next x
Else
With fileop
.hwnd = Me.hwnd
.wFunc = FO_COPY
[ô].pFrom = Origem & [Ô]Sub[Ô] & vbNullChar & vbNullChar
.pFrom = Origem & [Ô]*.*[Ô] & vbNullChar & vbNullChar
MkDir Destino & retranca
MkDir Destino & retranca & [Ô]\XDCAM001[Ô]
.pTo = Destino & retranca & [Ô]\XDCAM001[Ô] & vbNullChar & vbNullChar
.fFlags = FOF_ALLOWUNDO
End With
result = SHFileOperation(fileop)
[ô]Kill Destino & retranca & [Ô]\Sub\*.xml[Ô]
End If

If result = 0 Then
frmInputbox.Label1.Caption = [Ô]ARQUIVO COPIADO COM SUCESSO!![Ô]
frmInputbox.Caption = [Ô]COPIA COM SUCESSO![Ô]
frmInputbox.resposta.Visible = False
frmInputbox.btnresposta.Left = 3340
frmInputbox.btnresposta.Top = 840
frmInputbox.Show 1
End If

If result <> 0 Then
[ô] Operation failed
MsgBox Err.LastDllError
Else
If fileop.fAnyOperationsAborted <> 0 Then
MsgBox [Ô]Operação Falhou!![Ô], vbCritical, [Ô]Erro!![Ô]
End If
End If

Unload Me