Subida de Archivo a FTP Automatico?

bien resulta q estoy trabajandon en un simple programa q envia un archivo jpg para actualizar el sitio aca un cierto tiempo. os pongo el code, y el source para bajar. este por ejemplo esta con txt.

FORM1:

Código

Option Explicit
 
'Variable Para la clase
Dim Ftp As Class1
 
'Conectar al servidor FTP.
'***********************************
 
Private Sub cmdConectar_Click()
 
   With Ftp
 
      .Inicializar Me
      'Le establecemos la contraseña de la cuenta Ftp
      .PassWord = txtPassword
 
      'Le establecemos el nombre de usuario de la cuenta
      .Usuario = txtUsuario
 
      'Establecesmo el nombre del Servidor FTP
      .Servidor = txtServidor
 
      '...conectamos al servidor FTP. EL label es el control donde mostrar _
       los errores y el estado de la conexión
      If .ConectarFtp(Label4) = False Then
          MsgBox "No se puedo conectar"
         Exit Sub
       End If
      'Mostramos en el label el path del directorio actual donde estamos _
       ubicados en el servidor
       lblDiractual = Ftp.GetDirectorioActual
 
       'Le indicamos el ListView donde se listarán los archivos
       Set .ListView = ListView1
 
      .ListarArchivos
   End With
      'Habilitamos los controles del frame2 (subir archivo, bajar, borrar etc..)
      Frame2.Enabled = True
 
End Sub
 
Private Sub CmdDesconectar_Click()
'Desconectamos del servidor FTP
Ftp.Desconectar
Frame2.Enabled = False
End Sub
 
'Establece el modo de transferencia (binario, Ascii o desconocido)
Private Sub Combo1_Click()
Select Case Combo1.ListIndex
  Case 0: Ftp.TipoTransferencia = [ ASCII ]
  Case 1: Ftp.TipoTransferencia = [ BINARIO ]
  Case 2: Ftp.TipoTransferencia = [ DESCONOCIDO ]
End Select
 
End Sub
 
'Crear Directorio en el directorio FTP actual
Private Sub Command1_Click()
Dim carpeta As String
carpeta = InputBox("Escriba el nombre de la carpeta", "Crear directorio")
If carpeta <> "" Then
   Ftp.CrearDirectorio carpeta
End If
End Sub
 
 
'Sube un archivo al FTP
Private Sub Command3_Click()
'On Error GoTo errsub
Dim i As Integer
cd.CancelError = True
'cd.ShowOpen
If cd.FileName = "F:\code\sitio\tren.txt" Then Exit Sub
 
For i = 1 To ListView1.ListItems.Count
    If cd.FileTitle = ListView1.ListItems(i) Then
       If MsgBox("El archivo que itenta subir ya existe. ¿Sobreescribirlo?", _
                  vbQuestion + vbYesNo) = vbYes Then
 
         ListView1.ListItems.Remove i
         Ftp.SubirArchivo cd.FileName, cd.FileTitle
         Exit Sub
        Else
         Exit For
       End If
    End If
Next
 
Ftp.SubirArchivo cd.FileName, cd.FileTitle
 
Exit Sub
errsub:
If Err.Number = 32755 Then Exit Sub
End Sub
 
Private Sub Command2_Click()
    'Actualiza el ListView mostrando los dir y archivos del dir Ftp actual
    Ftp.Actualizar
End Sub
 
 
'Renombrar archivo remoto
Private Sub Command4_Click()
Dim localFile As String, nuevoNombre As String
 
nuevoNombre = InputBox("Se va a renombrar el archivo: " & ListView1.SelectedItem & vbCrLf & "Escriba el nuevo nombre para este archivo")
 
If nuevoNombre = "" Then Exit Sub
 
Ftp.RenombrarArchivo ListView1.SelectedItem, nuevoNombre
 
End Sub
 
 
'Eliminar archivo
Private Sub Command5_Click()
If ListView1.SelectedItem Is Nothing Then MsgBox "No hay ningún archivo seleccionado para eliminar", vbInformation: Exit Sub
 
If MsgBox("Eliminar el archivo:" & ListView1.SelectedItem & "??", vbYesNo + vbExclamation) = vbYes Then
   Ftp.EliminarArchivo ListView1.SelectedItem
   ListView1.ListItems.Remove ListView1.SelectedItem.Index
End If
End Sub
 
 
'Eliminar carpeta Ftp
Private Sub Command6_Click()
If ListView1.SelectedItem Is Nothing Then MsgBox "No hay ninguna carpeta seleccionada para eliminar", vbInformation: Exit Sub
 
If MsgBox("Eliminar el Directorio: " & vbCrLf & ListView1.SelectedItem & "??", vbYesNo + vbExclamation) = vbYes Then
   Ftp.EliminarDirectorio ListView1.SelectedItem
   ListView1.ListItems.Remove ListView1.SelectedItem.Index
End If
 
 
End Sub
 
'Descarga un archivo del FTP
Private Sub Command7_Click()
Dim pathLocal As String
pathLocal = InputBox("Escriba la ruta donde descargar el archivo remoto" & vbCrLf & ListView1.SelectedItem, "descargar archivo", "c:\")
  If pathLocal = "" Then
     Exit Sub
  Else
     Ftp.ObtenerArchivo ListView1.SelectedItem, pathLocal & _
                        ListView1.SelectedItem
  End If
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
'Eliminamos la referencia de la clase
Set Ftp = Nothing
End Sub
 
'Cambia de directorio y actualiza la lista al hacer dobleclick
Private Sub ListView1_DblClick()
If ListView1.SelectedItem.SmallIcon = "carpeta" Then
   'cambiamos de Dir
   Ftp.CambiarDirectorio ListView1.SelectedItem
   Ftp.ListarArchivos 'Lista los archivos
   'Mostramos el directorio actual en el Label
   lblDiractual = Ftp.GetDirectorioActual
 
End If
End Sub
 
 
 
Private Sub Form_Load()
Set Ftp = New Class1
Combo1 = Combo1.List(0)
   With Ftp
 
      .Inicializar Me
      'Le establecemos la contraseña de la cuenta Ftp
      .PassWord = txtPassword
 
      'Le establecemos el nombre de usuario de la cuenta
      .Usuario = txtUsuario
 
      'Establecesmo el nombre del Servidor FTP
      .Servidor = txtServidor
 
      '...conectamos al servidor FTP. EL label es el control donde mostrar _
       los errores y el estado de la conexión
      If .ConectarFtp(Label4) = False Then
          MsgBox "No se puedo conectar"
         Exit Sub
       End If
      'Mostramos en el label el path del directorio actual donde estamos _
       ubicados en el servidor
       lblDiractual = Ftp.GetDirectorioActual
 
       'Le indicamos el ListView donde se listarán los archivos
       Set .ListView = ListView1
 
      .ListarArchivos
   End With
      'Habilitamos los controles del frame2 (subir archivo, bajar, borrar etc..)
      Frame2.Enabled = True
      On Error GoTo errsub
Dim i As Integer
'cd.CancelError = True
'cd.ShowOpen
If cd.FileName = "F:\code\sitio\tren.txt" Then Exit Sub
 
For i = 1 To ListView1.ListItems.Count
    If cd.FileTitle = ListView1.ListItems(i) Then
       If MsgBox("El archivo que itenta subir ya existe. ¿Sobreescribirlo?", _
                  vbQuestion + vbYesNo) = vbYes Then
 
          ListView1.ListItems.Remove i
          Ftp.SubirArchivo cd.FileName, cd.FileTitle
          Exit Sub
        Else
          Exit For
       End If
    End If
Next
 
Ftp.SubirArchivo cd.FileName, cd.FileTitle
 
Exit Sub
errsub:
If Err.Number = 32755 Then Exit Sub
End Sub

Class1:

Código

'Path mas largo
Private Const MAX_PATH = 260
'Constante para el atributo de directorio
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
 
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
 
Private Type SYSTEMTIME
    intYear As Integer
    intMonth As Integer
    intDayOfWeek As Integer
    intDay As Integer
    intHour As Integer
    intMinute As Integer
    intSecond As Integer
    intMilliSeconds As Integer
End Type
 
 
'--- tipos de archivos --- para el Upload y Download
Private Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
 
'Puerto FTP
Private Const INTERNET_DEFAULT_FTP_PORT = 21
Private Const INTERNET_SERVICE_FTP = 1
 
' Modo de conexión FTP
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const PassiveConnection As Boolean = True
 
'--- formas de entrar en internet ---
' usa config del registro
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
' directo a internetnet
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
' via  proxy
Private Const INTERNET_OPEN_TYPE_PROXY = 3
' prevent using java/script/INS
Private Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
 
'Type para atributos de fecha y hora de archivos
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
 
'Otros atributos de archivo tamaño, nombre, fecha etc..
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
 
' Declaraciones Apis
'***************************************************************
 
 
Private Declare Function InternetCloseHandle _
  Lib "wininet.dll" (ByVal hInet As Long) As Integer
'Establece una conexión a internet para poder iniciar seción Ftp
Private Declare Function InternetConnect _
  Lib "wininet.dll" Alias "InternetConnectA" _
  (ByVal hInternetSession As Long, _
   ByVal sServerName As String, _
   ByVal nServerPort As Integer, _
   ByVal sUserName As String, _
   ByVal sPassword As String, _
   ByVal lService As Long, ByVal lFlags As Long, _
   ByVal lContext As Long) As Long
'Conecta al Ftp
Private Declare Function InternetOpen _
  Lib "wininet.dll" Alias "InternetOpenA" _
   (ByVal sAgent As String, ByVal lAccessType As Long, _
    ByVal sProxyName As String, _
    ByVal sProxyBypass As String, _
    ByVal lFlags As Long) As Long
'Establece el path corriente
Private Declare Function FtpSetCurrentDirectory _
   Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
   (ByVal hFtpSession As Long, _
    ByVal lpszDirectory As String) As Boolean
'Recupera el path corriente
Private Declare Function FtpGetCurrentDirectory _
   Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _
  (ByVal hFtpSession As Long, _
   ByVal lpszCurrentDirectory As String, _
   lpdwCurrentDirectory As Long) As Long
'Crea un directorio
Private Declare Function FtpCreateDirectory _
   Lib "wininet.dll" Alias "FtpCreateDirectoryA" _
   (ByVal hFtpSession As Long, _
   ByVal lpszDirectory As String) As Boolean
'Elimina un directorio del FTP
Private Declare Function FtpRemoveDirectory _
  Lib "wininet.dll" Alias "FtpRemoveDirectoryA" _
  (ByVal hFtpSession As Long, _
  ByVal lpszDirectory As String) As Boolean
'Borra un fichero
Private Declare Function FtpDeleteFile _
  Lib "wininet.dll" Alias "FtpDeleteFileA" _
  (ByVal hFtpSession As Long, _
  ByVal lpszFileName As String) As Boolean
'Renombra un fichero
Private Declare Function FtpRenameFile _
  Lib "wininet.dll" Alias "FtpRenameFileA" _
  (ByVal hFtpSession As Long, _
  ByVal lpszExisting As String, _
  ByVal lpszNew As String) As Boolean
'Recupera un archivo
Private Declare Function FtpGetFile Lib "wininet.dll" _
   Alias "FtpGetFileA" (ByVal hConnect As Long, _
  ByVal lpszRemoteFile As String, _
  ByVal lpszNewFile As String, ByVal fFailIfExists As Long, _
  ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, _
  ByRef dwContext As Long) As Boolean
'Escribe un archivo
Private Declare Function FtpPutFile Lib "wininet.dll" _
   Alias "FtpPutFileA" (ByVal hConnect As Long, _
  ByVal lpszLocalFile As String, _
  ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, _
  ByVal dwContext As Long) As Boolean
'Api Para los errores
Private Declare Function InternetGetLastResponseInfo _
  Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" _
  (lpdwError As Long, ByVal lpszBuffer As String, _
   lpdwBufferLength As Long) As Boolean
'Busca el primer archivo de un path
Private Declare Function FtpFindFirstFile Lib "wininet.dll" _
   Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, _
   ByVal lpszSearchFile As String, _
   lpFindFileData As WIN32_FIND_DATA, _
   ByVal dwFlags As Long, ByVal dwContent As Long) As Long
'api para buscar el siguiente archivo
Private Declare Function InternetFindNextFile Lib "wininet.dll" _
   Alias "InternetFindNextFileA" (ByVal hFind As Long, _
   lpvFindData As WIN32_FIND_DATA) As Long
 
 
 
Public Enum e_TipoTransferencia
[ BINARIO ] = FTP_TRANSFER_TYPE_BINARY
[ ASCII ] = FTP_TRANSFER_TYPE_ASCII
[ DESCONOCIDO ] = FTP_TRANSFER_TYPE_UNKNOWN
End Enum
 
    'Handle de la conexión Ftp
    Dim HandleConect As Long
    'Handle de la conexión a Internet
    Dim hOpen As Long
 
'Variables locales
Private m_DirectorioActual As String
Private m_Usuario As String
Private m_PassWord As String
Private m_Servidor As String
Private m_DirAnterior As String
Private m_listView As ListView
Private m_TipoTransferencia  As Long
Private m_form As Form
 
Private ctrl As Object
 
'Funciones Varias para el manejo de archivos y carpetas en el servidor Ftp
'***********************************************************************
'***********************************************************************
 
'Rutina que conecta al Servidor Ftp
Public Function ConectarFtp(Optional ControlStatus As Object _
                            = Nothing) As Boolean
 
'Verificamos que los datos de la cuenta estén establecidas, si no mostramos un _
 mensaje y salimos
If m_Usuario = "" Or m_Servidor = "" Or m_PassWord = "" Then
   MsgBox "No se puede conectar. Verifique el Nombre de usuario," _
   & "El nombre del Servidor y la contraseña que estén establecidas", vbCritical
   ConectarFtp = False
   Exit Function
End If
 
 
   Set ctrl = ControlStatus
   Status "...Intentando conectar a: " & m_Servidor
   m_form.MousePointer = vbHourglass
 
'Abrimos una conexión a Internet
hOpen = InternetOpen(vbNullString, _
        INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, _
        vbNullString, 0)
 
If hOpen = 0 Then
   Status "Error en la conexión a internet, compruebe la conexión"
   m_form.MousePointer = vbDefault
   ConectarFtp = False
   Exit Function
End If
'Conectamos al servidor FTP, pasandole los datos: login y servidor
HandleConect = InternetConnect(hOpen, m_Servidor, _
               INTERNET_DEFAULT_FTP_PORT, m_Usuario, _
               m_PassWord, INTERNET_SERVICE_FTP, _
               IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
 
If HandleConect = 0 Then
   Status "Error. Compruebe los datos del servidor Ftp sin son correctos"
   m_form.MousePointer = vbDefault
   ConectarFtp = False
   Exit Function
End If
Status "Conectado a: " & m_Servidor
m_form.MousePointer = vbDefault
ConectarFtp = True
End Function
 
'Desconecta del servidor FTP
'**************************************************
Public Sub Desconectar()
    Dim ret As Long
    'cierra la conexion FTP
    ret = InternetCloseHandle(HandleConect)
    If ret = 0 Then Status "Error al desconectar": Exit Sub
    'cierra la conexion a internet
    ret = InternetCloseHandle(hOpen)
    If ret = 0 Then Status "Error al desconectar": Exit Sub
 
    Status "Desconectado de: " & m_Servidor
    Class_Terminate
End Sub
 
'Recupera el directorio actual donde estamos ubicados
'*****************************************************
Public Function GetDirectorioActual() As String
    'Crea un buffer
    m_DirectorioActual = String(MAX_PATH, 0)
    'Obtenemos el directorio actual
     ret = FtpGetCurrentDirectory(HandleConect, m_DirectorioActual, _
           Len(m_DirectorioActual))
     GetDirectorioActual = m_DirectorioActual
End Function
 
'Establecemos el Directorio Actual
'****************************************************
Public Sub CambiarDirectorio(PathDirectorio As String)
 
 
    Dim pData As WIN32_FIND_DATA
    Dim hFind As Long  'handle usado para buscar fichs en FTP
    Dim ret As Long
    Dim strDir As String
 
 
 
    strDir = Replace(m_DirectorioActual, Chr(0), "")
 
    If strDir = "/" And PathDirectorio = "../Subir un nivel" Then: Exit Sub
 
    m_form.MousePointer = vbHourglass
 
    If PathDirectorio = "../Subir un nivel" Then
      pos = InStrRev(strDir, "/")
      strDir = Left(strDir, pos)
 
 
 
      'Cambia al Directorio Ftp especificado
       ret = FtpSetCurrentDirectory(HandleConect, strDir)
 
       If ret = 0 Then
          Status "Error al cambiar de directorio."
       End If
       m_form.MousePointer = vbDefault
       Exit Sub
    End If
 
    'Cambia al Directorio especificado
    ret = FtpSetCurrentDirectory(HandleConect, strDir & "/" & PathDirectorio)
 
    If ret = 0 Then
       Status "Error al cambiar de directorio"
    End If
    m_form.MousePointer = vbDefault
 
End Sub
 
 
'Crea un nuevo directorio
'*******************************************
Public Sub CrearDirectorio(NameDirectorio As String)
 
'Creamos un nuevo  directorio ('testing')
ret = FtpCreateDirectory(HandleConect, NameDirectorio)
If Not ret Then
   Status "Error al crear el directorio, compruebe el nombre que sea válido"
Else
   m_listView.ListItems.Add , , NameDirectorio, , "carpeta"
   m_listView.ListItems(m_listView.ListItems.Count).Selected = True
   m_listView.SetFocus
End If
 
End Sub
 
'Crea o sube un nuevo Archivo.
'********************************************
Public Sub SubirArchivo(localArchivo As String, NombreArchivoRemoto As String)
'manda fichero al servidor FTP
ret = FtpPutFile(HandleConect, localArchivo, NombreArchivoRemoto, _
           m_TipoTransferencia, 0)
If ret Then
   m_listView.ListItems.Add , , NombreArchivoRemoto, , "archivo"
   m_listView.ListItems(m_listView.ListItems.Count).Selected = True
   m_listView.SetFocus
Else
   Status "Error al subir el fichero:" & NombreArchivoRemoto
End If
End Sub
 
 
'Renombra un archivo en el directorio Ftp corriente
'****************************************************
Public Sub RenombrarArchivo(Archivo As String, nuevoNombre As String)
 
'renombra 'test.htm' to 'apiguide.htm'
ret = FtpRenameFile(HandleConect, Archivo, nuevoNombre)
 
If ret Then
   m_listView.SelectedItem.Text = nuevoNombre
   m_listView.SetFocus
Else
   Status "Error al renombrar el fichero:" & nuevoNombre
End If
 
End Sub
 
 
Public Sub ObtenerArchivo(ArchivoRemoto As String, ArchivoLocal As String, _
           Optional SobreEscribir As Boolean = False)
'recupera fichero del servidor FTP: ArchivoRemoto es el nombre del archivo remoto
'ArchivoLocal es el nombre y ruta donde se colocará el archivo en local
ret = FtpGetFile(HandleConect, ArchivoRemoto, ArchivoLocal, _
           SobreEscribir, 0, m_TipoTransferencia, 0)
 
If ret Then
   Status "Archivo descargado correctamente:"
   m_listView.SetFocus
Else
   Status "Error al intentar descargar el fichero: " & ArchivoRemoto
End If
 
End Sub
 
'Eliminar Archivo del servidor Ftp
Public Sub EliminarArchivo(Archivo As String)
 'elimina el fichero del servidor FTP
 ret = FtpDeleteFile(HandleConect, Archivo)
 If Not ret Then
    Status "Error. No se pudo eliminar el archivo: " & Archivo
 End If
End Sub
 
 
Public Sub EliminarDirectorio(Directorio As String)
'elimina el directorio
ret = FtpRemoveDirectory(HandleConect, Directorio)
 If Not ret Then
    Status "Error. No se pudo eliminar el Directorio: " & Directorio
 End If
End Sub
 
Private Sub Status(mensaje As String)
On Error GoTo SubError
ctrl = mensaje
Exit Sub
SubError:
If Err.Number = 91 Then Resume Next
End Sub
 
 
Public Sub ListarArchivos()
    Dim Item As ListItem
    Dim pData As WIN32_FIND_DATA
    Dim hFind As Long  'handle usado para buscar fichs en FTP
    Dim ret As Long   'valor devuelto por API
 
 
    m_form.MousePointer = vbHourglass
 
    'crea buffer
    pData.cFileName = String(MAX_PATH, 0)
 
    'busca el primer fichero
    hFind = FtpFindFirstFile(HandleConect, "*.*", pData, 0, 0)
 
    m_listView.ListItems.Clear
 
    'Si Hfind vale 0 es porque no hay archivos ni directorios
    If hFind = 0 Then
       Set Item = m_listView.ListItems.Add(, , "../Subir un nivel", , "carpeta")
       Item.SubItems(2) = getFecha(pData)
       m_form.MousePointer = vbDefault
       Exit Sub
    End If
 
 
    Set Item = m_listView.ListItems.Add(, , "../Subir un nivel", , "carpeta")
 
    If pData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
       Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "carpeta")
       Item.SubItems(2) = getFecha(pData)
    Else
 
       Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "archivo")
       Item.SubItems(1) = Round((pData.nFileSizeLow / 1024), 2) & " Kb"
       Item.SubItems(2) = getFecha(pData)
    End If
 
    'si no hay mas Archivos sale
    If hFind = 0 Then
       m_form.MousePointer = vbDefault
       Exit Sub
    End If
    Do
        'crea buffer
        pData.cFileName = String(MAX_PATH, 0) 'se llena con nulos
        'find the next file
        ret = InternetFindNextFile(hFind, pData)
        'si no hay ficheros, no sigue
        If ret = 0 Then Exit Do
 
 
    If pData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Or _
                               pData.dwFileAttributes = 0 Then
       'Agrega el nombre del directorio
       Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "carpeta")
       Item.SubItems(2) = getFecha(pData)
    Else
       'agrega el archivo y Muestra el tamaño del mismo en el LV
       Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "archivo")
       Item.SubItems(1) = Round((pData.nFileSizeLow / 1024), 2) & " Kb"
       Item.SubItems(2) = getFecha(pData)
    End If
 
    Loop
    'Cerramos el handle de búsqueda
    InternetCloseHandle hFind
    m_listView.Sorted = True
    m_form.MousePointer = vbDefault
End Sub
 
 
'Actualiza la lista de Archivos y directorios en el ListView
'************************************************************
Public Sub Actualizar()
 
    Dim pData As WIN32_FIND_DATA
    Dim hFind As Long  'handle usado para buscar fichs en FTP
    Dim ret As Long   'valor devuelto por API
    Dim Item As ListItem
 
 
    m_form.MousePointer = vbHourglass
 
    'crea buffer
    pData.cFileName = String(MAX_PATH, 0)
 
    'busca el primer fichero
    hFind = FtpFindFirstFile(HandleConect, "*.*", pData, 0, 0)
 
    m_listView.ListItems.Clear
 
    If hFind = 0 Then
       Set Item = m_listView.ListItems.Add(, , "../Subir un nivel", , "carpeta")
       m_form.MousePointer = vbDefault
       Exit Sub
    End If
 
 
    Set Item = m_listView.ListItems.Add(, , "../Subir un nivel", , "carpeta")
 
    If pData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Then
       Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "carpeta")
       Item.SubItems(2) = getFecha(pData)
    Else
       Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "archivo")
       Item.SubItems(1) = Round((pData.nFileSizeLow / 1024), 2) & " Kb"
       Item.SubItems(2) = getFecha(pData)
    End If
 
    'si no hay mas Archivos sale
    If hFind = 0 Then
       m_form.MousePointer = vbDefault
       Exit Sub
    End If
    Do
        'crea buffer
        pData.cFileName = String(MAX_PATH, 0) 'se llena con nulos
        'find the next file
        ret = InternetFindNextFile(hFind, pData)
        'si no hay ficheros, no sigue
        If ret = 0 Then Exit Do
        'Archivo
 
    If pData.dwFileAttributes = FILE_ATTRIBUTE_DIRECTORY Or pData.dwFileAttributes = 0 Then
       Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "carpeta")
       Item.SubItems(2) = getFecha(pData)
 
    Else
       Set Item = m_listView.ListItems.Add(, , pData.cFileName, , "archivo")
 
       Item.SubItems(1) = Round((pData.nFileSizeLow / 1024), 2) & " Kb"
       Item.SubItems(2) = getFecha(pData)
 
 
 
 
    End If
 
    Loop
    'Cerramos el handle de búsqueda
    InternetCloseHandle hFind
    m_listView.Sorted = True
    m_form.MousePointer = vbDefault
End Sub
 
 
Private Function getFecha(pData As WIN32_FIND_DATA) As Date
   Dim stSystemTime As SYSTEMTIME
 
            If FileTimeToSystemTime(pData.ftLastWriteTime, stSystemTime) > 0 Then
                VBATime = DateSerial(stSystemTime.intYear, _
                 stSystemTime.intMonth, _
                stSystemTime.intDay) + TimeSerial(stSystemTime.intHour, _
                stSystemTime.intMinute, stSystemTime.intSecond)
            End If
            getFecha = VBATime
End Function
 
 
Public Sub Inicializar(Formulario As Form)
     Set m_form = Formulario
End Sub
 
'Para mostrar los errores
'************************************************+
Private Sub ShowError()
    Dim lngNumError As Long
    Dim strMemoError As String
    Dim lngTamBuffer As Long
    '-----------------------------
    'Tamaño del buffer
    InternetGetLastResponseInfo lngNumError, _
       strMemoError, lngTamBuffer
    'crea buffer
    strMemoError = String(lngTamBuffer, 0)
    'Recupera informacion del error
    InternetGetLastResponseInfo lngNumError, _
        strMemoError, lngTamBuffer
    'Mostrar el error en msgbox
    MsgBox "Error " & CStr(lngNumError) & ": " & strMemoError, _
       vbOKOnly Or vbCritical
End Sub
 
 
'Nombre de usuario de la cuenta Ftp
'**********************************
Public Property Get Usuario() As String
Usuario = m_Usuario
End Property
 
Public Property Let Usuario(ByVal vNewValue As String)
m_Usuario = vNewValue
End Property
 
'Nombre del servidor Ftp
'***********************
Public Property Get Servidor() As String
Servidor = m_Servidor
End Property
 
Public Property Let Servidor(ByVal vNewValue As String)
m_Servidor = vNewValue
End Property
 
'Contraseña de la cuenta FTP
'***************************
Public Property Get PassWord() As String
PassWord = m_PassWord
End Property
 
Public Property Let PassWord(ByVal vNewValue As String)
m_PassWord = vNewValue
End Property
 
'Establece el ListView donde listar los ficheros
'***********************************************
Public Property Get ListView() As ListView
Set ListView = m_listView
End Property
 
Public Property Set ListView(ByVal vNewValue As ListView)
Set m_listView = vNewValue
End Property
 
'Modo de Transferencia
'**********************************************
Public Property Get TipoTransferencia() As e_TipoTransferencia
    TipoTransferencia = m_TipoTransferencia
End Property
Public Property Let TipoTransferencia(NewData As e_TipoTransferencia)
    m_TipoTransferencia = NewData
End Property
 
 
Private Sub Class_Terminate()
On Local Error Resume Next
  'Cerramos la cesión FTP y la conexión a internet
  InternetCloseHandle HandleConect
  InternetCloseHandle hOpen
  'Eliminamos las variables de objeto
  Set ctrl = Nothing
  Set ListView = Nothing
  Set m_form = Nothing
End Sub

Proyecto: http://www.mediafire.com/?irabj2910123ird

Ahora mi problema es q mi servidor me da una carpeta "public_html"; donde tengo q guardar el archivo jpg. pero no puedo hacer que lo envie automaticamente a esa carpeta. alguien me podra dar una mano con esto?