Ver Mensaje Individual
  #4 (permalink)  
Antiguo 31/03/2006, 04:34
zabait
 
Fecha de Ingreso: mayo-2005
Mensajes: 93
Antigüedad: 20 años
Puntos: 1
muy bien, ahí va el mio...

Código:
Function ENVIARFTP

Public bActiveSession As Boolean
Public hOpen As Long, hConnection As Long
Public dwType As Long

'Conectarse a internet
    hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
'    If hOpen = 0 Then ErrorOut Err.LastDllError, "InternetOpen"
    If hOpen = 0 Then
        txtProceso = "*** ERROR FTP *** " & Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - ERROR de conexión a internet." & _
                        vbCrLf & txtProceso
        Exit Sub
    End If
    
'Datos del servidor FTP
    
    Dim ipServidor As String
    Dim usuario As String
    Dim pwd As String
    Dim datos As String
    Dim rs As New ADODB.Recordset
    
    If Not bActiveSession And hOpen <> 0 Then
    
        Dim nFlag As Long
        
'        nFlag = INTERNET_FLAG_PASSIVE      'MODO PASIVO
        nFlag = 0                           'MODO ACTIVO

        hConnection = InternetConnect(hOpen, ipServidor, INTERNET_INVALID_PORT_NUMBER, _
        usuario, pwd, INTERNET_SERVICE_FTP, nFlag, 0)
        If hConnection = 0 Then
            bActiveSession = False
            txtProceso = "*** ERROR FTP *** " & Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ")-  ERROR de conexión con el servidor." & _
                            vbCrLf & txtProceso
        Else
            bActiveSession = True
       End If
       
    End If
    
    '*****************************************************************************************
    'Envío de documentos al servidor FTP
    '*****************************************************************************************
    
    Dim errorLocalizable As Boolean
    Dim txtErrorLocalizable As String
    
    errorLocalizable = False
    txtErrorLocalizable = ""
    
    Dim fila As Integer
    
    With FGPendientes
        
        For fila = 1 To .Rows - 1
        'recorremos todas las lineas del grid de documentos pendientes de envío
        
        
            On Error GoTo errorEnvio
            
            Dim bRet As Boolean
            Dim szFileRemote As String, szDirRemote As String, szFileLocal As String
            Dim szTempString As String
            Dim nPos As Long, nTemp As Long
            Dim auxStr As String
            
            If bActiveSession Then
                            
                auxStr = [Obetenemos datos de donde debemos guardar el documento en el Servidor FTP]
                
                szTempString = ipServidor
                szDirRemote = "\"
                szFileRemote = auxStr
                szFileLocal = [Obtenemos el dato del directorio local]
                
                txtProceso = Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - Enviando documento ... " & _
                            Right(szFileLocal, Len(szFileLocal) - InStrRev(szFileLocal, "\")) & _
                            vbCrLf & txtProceso
                
                rcd szDirRemote
                
                bRet = FtpPutFile(hConnection, szFileLocal, szFileRemote, dwType, 0)
                 
                If bRet = False Then
                    txtErrorLocalizable = "Error al intentar grabar el documento en el servidor FTP."
                    errorLocalizable = True
                    GoTo errorEnvio
                Else
                    
                    txtProceso = Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - Documento enviado." & _
                            Right(szFileLocal, Len(szFileLocal) - InStrRev(szFileLocal, "\")) & _
                            vbCrLf & txtProceso
                End If
           End If
           
           On Error GoTo 0
           GoTo seguir
           
errorEnvio:

            If Not errorLocalizable Then
                txtProceso = "*** ERROR FTP *** " & Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - Error indetectable en el envío del documento " & szFileLocal & _
                            vbCrLf & txtProceso
            Else
                txtProceso = "*** ERROR FTP *** " & Format(Now, "DD/MM/YYYY") & "(" & Format(Now, "hh:mm:ss") & ") - " & txtErrorLocalizable & _
                            vbCrLf & txtProceso
            End If

End function
Se necesita un .bas que no puedo adjuntar porque es demaiado largo.
Si alguien lo quiere... que se ponga en contacto conmigo

De todas formas, muy buen código el tuyo.
Si realmente funciona (que ahora no puedo probarlo), muy bueno. felicidades!!!

¿¿¿¿A que se parecen????
__________________
No te hubieran dado la capacidad de soñar sin darte también la posibilidad de convertir tus sueños en realidad