Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Datei zum FTP-Server up- und vom FTP-Server downloaden

Gruppe

Internet

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