Postada em 05/03/2010 09:37 hs
Function ConectareEnviar()
Dim arquivos As String
Dim TodosEnviados As Boolean
Dim QtdeErros As Long
Dim vFso As FileSystemObject
Set vFso = New FileSystemObject
Me.MousePointer = vbHourglass
Label1.Caption = "Conectando ao site FTP..."
Label1.Refresh
arquivos = Dir("C: este" & "*.txt", vbArchive)
If arquivos <> "" Then
FTP1.Conectar "192.1.1.1", "usuario", "senha"
If FTP1.Conectado Then
TodosEnviados = True
QtdeErros = 0
Do While arquivos <> ""
Label1.Caption = "Abrindo pasta teste..."
Label1.Refresh
FTP1.AbrirDiretorio "/teste/pasta1/"
Label1.Caption = "Aguarde... Enviando arquivo " & arquivos
Label1.Refresh
FTP1.Enviar "c: este", arquivos
Label1.Caption = "Arquivos enviados com sucesso!"
Label1.Caption = ""
If FTP1.ErroDescricao = "" Then
If vFso.FileExists("c: esteprecessados" & "" & arquivos) Then
vFso.DeleteFile ("c: esteprecessados" & "" & arquivos), True
End If
vFso.MoveFile ("c: este" & "" & arquivos), ("c: esteprecessados" & "" & arquivos)
Else
Label1.Caption = "Erro ao enviar o arquivo " & arquivos & ". Tente novamente."
Label1.Caption = ""
'MsgBox "Erro ao enviar o arquivo " & arquivos & ". Tente novamente.", vbCritical, "ERRO"
FTP1.Desconectar
Me.MousePointer = vbArrow
TodosEnviados = False
QtdeErros = QtdeErros + 1
Exit Function
End If
arquivos = Dir
Loop
End If
Label1.Caption = "Não haviam arquivos para serem transferidos."
Label1.Refresh
Label1.Caption = ""
End If
Me.MousePointer = vbArrow
End Function
|
