Gruppe
Extern
Bereich
Internet
Thema
Datei zum FTP-Server up- und vom FTP-Server downloaden
Problem
Eine Excel-Datei mit vorgegebenem Namen soll zum WWW-Server hochund vom Server runtergeladen werden. Nach dem Download ist die Datei zu öffnen.
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: basMain
Sub DownIndexXLS()
Dim iFile As Integer
Dim sLog As String
iFile = FreeFile
sLog = Left(Range("B1").Value, 3) & "LogIn.txt"
Open sLog For Output As iFile
Print #iFile, Range("B3").Value
Print #iFile, Range("B4").Value
Print #iFile, "cd herber"
Print #iFile, "cd bbs"
Print #iFile, "cd texte"
Print #iFile, "binary"
Print #iFile, "get " & Range("B2").Value
Print #iFile, "quit"
Close iFile
Call Win32WaitTilFinished( _
"ftp -s:" & sLog & " " & Range("B5").Value)
Workbooks.Open Range("B1").Value & "\" & Range("B2").Value
End Sub
Sub UpIndexXLS()
Dim iFile As Integer
Dim sLog As String, sFile As String
iFile = FreeFile
sLog = Left(Range("B1").Value, 3) & "LogIn.txt"
Open sLog For Output As #iFile
Print #iFile, Range("B3").Value
Print #iFile, Range("B4").Value
Print #iFile, "cd herber"
Print #iFile, "cd bbs"
Print #iFile, "cd texte"
Print #iFile, "binary"
Print #iFile, "put " & Range("B1").Value & "\" & Range("B2").Value
Print #iFile, "quit"
Close
Shell "ftp -s:" & sLog & " " & Range("B5").Value, vbNormalFocus
MsgBox "Daten wurden hochgeladen!"
End Sub
StandardModule: basFunctions
Public Const PROCESS_QUERY_INFORMATION = &H400
Public Const WAIT_TIMEOUT = &H102&
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long
Sub Win32WaitTilFinished(ProgEXE As String)
Dim ProcessID As Long
Dim hProcess As Long
Dim RetVal As Long
ProcessID = Shell(ProgEXE, vbHide)
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, ProcessID)
Do
DoEvents
RetVal = WaitForSingleObject(hProcess, 50)
Loop Until RetVal <> WAIT_TIMEOUT
End Sub