
31/03/2006, 04:34
|
| | 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 |