Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
FTP
zurück: Userform Teil 12 Menüleiste weiter: Bitte lesen - bevor ein neuer Beitrag geschrieben wird ! Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Tutorial Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
Lukas Mosimann
Formeln gut, VBA sehr gut


Verfasst am:
22. Jun 2007, 19:12
Rufname: Lukas
Wohnort: CH-Pfaffnau

FTP - FTP

Nach oben
       Version: (keine Angabe möglich)

Hallo zusammen
Eine neue Internet-Anleitung folgt, dieses Mal lautet das Thema: FTP, wie lädt man Dateien herunter, wie lädt man eine Datei hoch, Rechte ändern oder sich auch ganz einfach im FTP-Server bewegen.
Hier der Code, Erklärungen zu den einzelnen Makros sind im Code enthalten.
Achtung: Gebraucht werden nur Makros, welche mit FTP beginnen

Code:
'Version vom 26.09.2010

Option Explicit

Private Declare Function WSACleanup Lib "ws2_32.dll" () As Long
Private Declare Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequired As Integer, ByRef lpWSAData As WSAData) As Long
Private Declare Function socket Lib "ws2_32.dll" (ByVal af As Long, ByVal lType As Long, ByVal protocol As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal length As Long)
Private Declare Function gethostbyname Lib "wsock32.dll" (ByVal name As String) As Long
Private Declare Function closesocket Lib "ws2_32.dll" (ByVal s As Long) As Long
Private Declare Function recv Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long) As Long
Private Declare Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal lLen As Long, ByVal flags As Long) As Long
Private Declare Function connect Lib "ws2_32.dll" (ByVal s As Long, ByRef name As SOCKADDR, ByVal namelen As Long) As Long
Private Declare Function inet_addr Lib "wsock32.dll" (ByVal cp As String) As Long
Private Declare Function htons Lib "wsock32.dll" (ByVal hostshort As Integer) As Integer
Private Declare Function ioctlsocket Lib "wsock32.dll" (ByVal s As Long, ByVal cmd As Long, argp As Long) As Long
Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Private Type DateiAuslesenResult
    result() As Byte
End Type

Private Type WSAData
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * 257
    szSystemStatus As String * 129
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

Private Type SOCKADDR
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero As String * 8
End Type
 
Private Type HOSTENT
   hname As Long
   haliases As Long
   haddrtype As Integer
   hlength As Integer
   haddrlist As Long
End Type

Type Benutzerrechte
    Eigentümer As Dateirechte
    Gruppe As Dateirechte
    sonstige As Dateirechte
End Type

Private Enum Dateirechte
    lesen = 4
    schreiben = 2
    Ausführen = 1
End Enum

Private Const AF_INET = 2
Private Const SOCK_STREAM = 1
Private Const MSG_PEEK = &H2
Private Const FIONBIO = &H8004667E

Private aSocket As Long
Private aHost As String
Private Timer As Long

Private Function IPAdresse(ByVal Adresse As String) As String
Dim pAdresse As Long, AdresseInfo As HOSTENT
Dim pIP As Long, IPArray(3) As Byte

Dim WSADaten As WSAData
WSAStartup &H202, WSADaten

pAdresse = gethostbyname(Adresse)
If pAdresse = 0 Then
    IPAdresse = 0
    Exit Function
End If

MoveMemory AdresseInfo, ByVal pAdresse, Len(AdresseInfo)

MoveMemory pIP, ByVal AdresseInfo.haddrlist, 4
MoveMemory IPArray(0), ByVal pIP, 4
WSACleanup

IPAdresse = IPArray(0) & "." & IPArray(1) & "." & IPArray(2) & "." & IPArray(3)
End Function

Private Function Verbinden(ByVal Adresse As String, ByVal Port As Long) As Long
Dim result
Dim SockAdresse As SOCKADDR

Dim intPort As Integer
Select Case Port
  Case Is <= &H7FFF
    intPort = Port
  Case &H8000
    intPort = Port * -1
  Case Else
    intPort = Port + &HFFFF0000
End Select


Verbinden = socket(AF_INET, SOCK_STREAM, 0&)
If Verbinden = -1 Then
    Verbinden = False
    Exit Function
End If

With SockAdresse
    .sin_addr = inet_addr(IPAdresse(Adresse))
    .sin_port = htons(intPort)
    .sin_family = AF_INET
    If .sin_port = -1 Then
        Verbinden = False
        Exit Function
    End If
End With
result = connect(Verbinden, SockAdresse, Len(SockAdresse))
If result <> 0 Then
    Verbinden = False
    Exit Function
End If
result = ioctlsocket(Verbinden, FIONBIO, 1&)
If result = -1 Then
    Verbinden = False
    Exit Function
End If
End Function

Private Function VerbindungTrennen(ByVal s As Long)
closesocket s
s = 0
End Function

Private Function DatenSenden(ByVal Data As String, ByVal s As Long) As Boolean
Dim Gesendet As Long
Do While Gesendet < Len(Data)
    If Gesendet = -1 Then Gesendet = send(s, ByVal Data, Len(Data), 0&) Else Gesendet = Gesendet + send(s, ByVal Data, Len(Data), 0&)
Loop
End Function

Private Function DatenAngekommen(ByVal s As Long) As Integer
Dim result As String * 1
DatenAngekommen = recv(s, ByVal result, Len(result), MSG_PEEK)
End Function

Private Function DatenEmpfangen(ByVal s As Long, Optional ByRef lngResult As Long) As String
Dim result As Long, Buffer As String * 60000
result = recv(s, Buffer, Len(Buffer), 0&)
lngResult = lngResult + result
DatenEmpfangen = Left$(Buffer, result)
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro kann die FTP-Verbindung gestartet werden.
'              Host         = z.B.xyz.de
'              Port         = Mit welchem Port soll sich das Makro verbinden (meist Port 21)
'              Benutzername = ist wohl selbst erklärend
'              Passwort     = ist wohl auch selbst erklärend
'              Achtung: Wenn FTPVerbinden gewählt wurde, muss in jedem Fall auch
'              FTPVerbindungTrennen gestartet werden!
'---------------------------------------------------------------------------------------
Sub FTPVerbinden(ByVal Host As String, ByVal Port As Long, ByVal Benutzername As String, ByVal Passwort As String)
Dim WSADaten As WSAData
Dim result
result = WSAStartup(&H202, WSADaten)
If result <> 0 Then
    MsgBox "Fehler bei WSAStartup"
    Exit Sub
End If

aSocket = Verbinden(Host, Port)
If aSocket = False Then
    MsgBox "Fehler bei Verbindung"
    WSACleanup
    Exit Sub
End If

Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Sub
End If

DatenSenden "USER " & Benutzername & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Sub
End If

DatenSenden "PASS " & Passwort & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Sub
End If

aHost = Host
StartTimer
End Sub

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro wird ermittelt, in welchem FTP-Verzeichnis man sich^
'              momentan befindet.
'              Rückgabewert = FTP-Verzeichnis
'---------------------------------------------------------------------------------------
Function FTPVerzeichnisErmitteln() As String
If aSocket = 0 Then
    MsgBox "Keine Verbindung"
    Exit Function
End If
DatenSenden "PWD" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
FTPVerzeichnisErmitteln = DatenEmpfangen(aSocket)
If Left(FTPVerzeichnisErmitteln, 1) * 1 = 4 Or Left(FTPVerzeichnisErmitteln, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & FTPVerzeichnisErmitteln
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If
Dim Zeichen1%, Zeichen2%
Zeichen1 = InStr(1, FTPVerzeichnisErmitteln, Chr(34))
Zeichen2 = InStr(Zeichen1 + 1, FTPVerzeichnisErmitteln, Chr(34))

FTPVerzeichnisErmitteln = Mid(FTPVerzeichnisErmitteln, Zeichen1 + 1, Zeichen2 - Zeichen1 - 1)
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit dem Makro kann der Inhalt eines Verzeichnisses komplett ausgelesen
'              werden, also mit allen Dateils (Rechte, etc.)
'              Rückgabewert = FTP-Informationen
'---------------------------------------------------------------------------------------
Function FTPVerzeichnisAuslesen() As String
Dim result
If aSocket = 0 Then
    MsgBox "Keine Verbindung"
    Exit Function
End If

FTPVerzeichnisErmitteln

DatenSenden "TYPE A" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If

Dim Passiv$, PortTeil1%, PortTeil2%, Port As Double
DatenSenden "PASV" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
Passiv = DatenEmpfangen(aSocket)
If Left(Passiv, 1) * 1 = 4 Or Left(Passiv, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & Passiv
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If
PortTeil1 = Mid(Passiv, InStrRev(Passiv, ",", InStrRev(Passiv, ",") - 1) + 1, InStrRev(Passiv, ",") - InStrRev(Passiv, ",", InStrRev(Passiv, ",") - 1) - 1)
PortTeil2 = Mid(Passiv, InStrRev(Passiv, ",") + 1, InStrRev(Passiv, ")") - InStrRev(Passiv, ",") - 1)
Port = 256 * CDbl(PortTeil1) + CDbl(PortTeil2)
Dim IP As String
IP = Mid(Passiv, InStr(1, Passiv, "(") + 1, InStr(InStr(InStr(InStr(1, Passiv, ",") + 1, Passiv, ",") + 1, Passiv, ",") + 1, Passiv, ",") - InStr(1, Passiv, "(") + 1 - 2)
IP = Replace(IP, ",", ".")

DatenSenden "LIST" & vbCrLf, aSocket

Dim PasvSocket%
PasvSocket = Verbinden(IP, Port)

Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)

Do Until DatenAngekommen(PasvSocket) = 0
    Do Until DatenAngekommen(PasvSocket) > 0: Loop
    FTPVerzeichnisAuslesen = FTPVerzeichnisAuslesen & DatenEmpfangen(PasvSocket)
Loop

closesocket PasvSocket

Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If

End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro wird die vorhandene Verbindung getrennt.
'              Achtung: Dieses Makro muss in jedem Fall ausgeführt werden.
'---------------------------------------------------------------------------------------
Sub FTPVerbindungTrennen()
DatenSenden "QUIT", aSocket
VerbindungTrennen (aSocket)
WSACleanup
LöscheTimer
End Sub

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro kann man den Ordner wechseln
'              Pfad         = Unterordner
'---------------------------------------------------------------------------------------
Sub FTPOrdnerWechseln(Pfad As String)
Dim result
DatenSenden "CWD " & Pfad & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Sub
End If
End Sub

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro kann man den Ordnerinhalt auslesen. Er wird jedoch ge-
'              rade sortiert in Rechte, Dateien, Grösse, Datum und Name
'              Result()     = Wird mit den Angaben gefüllt.
'---------------------------------------------------------------------------------------
Function FTPOrdnerAuswerten(result() As Variant)
Dim Text As String
Text = FTPVerzeichnisAuslesen

Dim Sortiert() As Variant
ReDim Sortiert(6, 0)

Sortiert(0, 0) = "Rechte"
Sortiert(1, 0) = "Dateien"
Sortiert(2, 0) = "Grösse"
Sortiert(3, 0) = "Monat"
Sortiert(4, 0) = "Tag"
Sortiert(5, 0) = "Zeit"
Sortiert(6, 0) = "Name"

If Text = "" Then Exit Function

Dim Ort As Long
Ort = -1
Do Until InStr(Ort + 2, Text, vbCrLf) = 0
    ReDim Preserve Sortiert(6, UBound(Sortiert, 2) + 1)
    Sortiert(0, UBound(Sortiert, 2)) = Mid(Text, (Ort + 2), 10)
    Sortiert(1, UBound(Sortiert, 2)) = Trim(Mid(Text, Ort + 13, 4)) * 1
    Sortiert(2, UBound(Sortiert, 2)) = Trim(Mid(Text, Ort + 33, 11)) * 1
    Sortiert(3, UBound(Sortiert, 2)) = Trim(Mid(Text, Ort + 45, 3))
    Sortiert(4, UBound(Sortiert, 2)) = Trim(Mid(Text, Ort + 48, 3)) * 1
    Sortiert(5, UBound(Sortiert, 2)) = Trim(Mid(Text, Ort + 52, 5))
    Sortiert(6, UBound(Sortiert, 2)) = Trim(Mid(Text, Ort + 58, InStr(Ort + 2, Text, vbCrLf) - Ort - 58))
    Ort = InStr(Ort + 2, Text, vbCrLf)
Loop

result = Sortiert
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro kann eine Datei gelöscht werden.
'              Dateiname    = Ist wohl selbst erklärend
'---------------------------------------------------------------------------------------
Function FTPDateiLöschen(Dateiname As String)
Dim result
DatenSenden "DELE " & Dateiname & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Function
End If
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit dem Makro wird eine Datei heruntergeladen
'              Dateiname    = Name der Datei, welche heruntergeladen werden soll.
'              Zielort      = Ort, wo die Datei dann hingespeichert werden soll.
'---------------------------------------------------------------------------------------
Function FTPDateiDownloaden(Dateiname As String, Zielort As String)
Dim result
If aSocket = 0 Then
    MsgBox "Keine Verbindung"
    Exit Function
End If

FTPVerzeichnisErmitteln

DatenSenden "TYPE I" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If

Dim Passiv$, PortTeil1%, PortTeil2%, Port As Double
DatenSenden "PASV" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
Passiv = DatenEmpfangen(aSocket)
If Left(Passiv, 1) * 1 = 4 Or Left(Passiv, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & Passiv
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If
PortTeil1 = Mid(Passiv, InStrRev(Passiv, ",", InStrRev(Passiv, ",") - 1) + 1, InStrRev(Passiv, ",") - InStrRev(Passiv, ",", InStrRev(Passiv, ",") - 1) - 1)
PortTeil2 = Mid(Passiv, InStrRev(Passiv, ",") + 1, InStrRev(Passiv, ")") - InStrRev(Passiv, ",") - 1)
Port = 256 * CDbl(PortTeil1) + CDbl(PortTeil2)
Dim IP As String
IP = Mid(Passiv, InStr(1, Passiv, "(") + 1, InStr(InStr(InStr(InStr(1, Passiv, ",") + 1, Passiv, ",") + 1, Passiv, ",") + 1, Passiv, ",") - InStr(1, Passiv, "(") + 1 - 2)
IP = Replace(IP, ",", ".")

DatenSenden "RETR " & Dateiname & vbCrLf, aSocket

Dim PasvSocket%
PasvSocket = Verbinden(IP, Port)

Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If

Dim intFile As Integer
intFile = FreeFile()
Open Zielort For Output As #intFile

Dim lngDataLength As Long, lngDataRecvLength As Long
lngDataLength = Left(Mid(result, InStrRev(result, "(") + 1), Len(Mid(result, InStrRev(result, "(") + 1)) - 9)
result = ""
Do Until lngDataLength <= lngDataRecvLength
    lngDataCnt = lngDataCnt + 1
    Do Until DatenAngekommen(PasvSocket) > 0: Loop
    result = DatenEmpfangen(PasvSocket, lngDataRecvLength)
    Print #intFile, result;
Loop
Print #intFile, result;

closesocket PasvSocket

Close #intFile
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro wird eine Datei auf den FTP-Server hochgeladen.
'              Quellpfad    = Pfad, woher die Datei (lokal) hochgeladen werden soll.
'              Zieldatei    = Wie soll die Datei auf dem FTP-Server heissen.
'---------------------------------------------------------------------------------------
Function FTPDateiHochladen(Quellpfad As String, Zieldatei As String)

Dim result
If aSocket = 0 Then
    MsgBox "Keine Verbindung"
    Exit Function
End If

FTPVerzeichnisErmitteln

DatenSenden "TYPE I" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If

Dim Passiv$, PortTeil1%, PortTeil2%, Port As Double
DatenSenden "PASV" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
Passiv = DatenEmpfangen(aSocket)
If Left(Passiv, 1) * 1 = 4 Or Left(Passiv, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & Passiv
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If
PortTeil1 = Mid(Passiv, InStrRev(Passiv, ",", InStrRev(Passiv, ",") - 1) + 1, InStrRev(Passiv, ",") - InStrRev(Passiv, ",", InStrRev(Passiv, ",") - 1) - 1)
PortTeil2 = Mid(Passiv, InStrRev(Passiv, ",") + 1, InStrRev(Passiv, ")") - InStrRev(Passiv, ",") - 1)
Port = 256 * CDbl(PortTeil1) + CDbl(PortTeil2)
Dim IP As String
IP = Mid(Passiv, InStr(1, Passiv, "(") + 1, InStr(InStr(InStr(InStr(1, Passiv, ",") + 1, Passiv, ",") + 1, Passiv, ",") + 1, Passiv, ",") - InStr(1, Passiv, "(") + 1 - 2)
IP = Replace(IP, ",", ".")

DatenSenden "STOR " & Zieldatei & vbCrLf, aSocket

Dim PasvSocket%
PasvSocket = Verbinden(IP, Port)

Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Verbindung fehlgeschlagen: " & result
    VerbindungTrennen (aSocket)
    WSACleanup
    Exit Function
End If

Dim intFile As Integer
intFile = FreeFile()
Open Quellpfad For Binary As #intFile

Dim lngDataLength As Long, lngDataSentLength As Long
Dim strData As String

result = ""
While Not EOF(intFile)
    strData = Input(32768, intFile)
   
    DatenSenden strData, PasvSocket
       
Wend

closesocket PasvSocket

Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)

Close #intFile

End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro wechselt man auf dem FTP-Server einen Ordner nach oben.
'---------------------------------------------------------------------------------------
Function FTPEbeneNachOben()
Dim result
DatenSenden "CDUP" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Function
End If
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro wird ein neuer Ordner erstellt
'              Ordnername   = Wie der neue Ordner heissen soll.
'---------------------------------------------------------------------------------------
Function FTPOrdnerErstellen(Ordnername As String)
Dim result
DatenSenden "MKD " & Ordnername & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Function
End If
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro wird ein Ordner gelöscht.
'              Ordnername   = Name des Ordners, welcher gelöscht werden soll.
'---------------------------------------------------------------------------------------
Function FTPOrdnerLöschen(Ordnername As String)
Dim result
DatenSenden "RMD " & Ordnername & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Function
End If
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro wird eine Datei verschoben oder umbenennt.
'              NameAlt      = Wie hat die Datei bisher geheissen
'              NameNeu      = Wie soll die Datei neu heissen
'
'Eine Datei in obere Ebene kopieren: z.B.
'NameAlt:   /Ordner/Dateiname.xls
'NameNeu:   /Dateiname.xls
'
'Eine Datei in untere Ebene kopieren: z.B.
'NameAlt:   Dateiname.xls
'DateiNeu:  /Ordner/Dateiname.xls
'
'EineDatei unbenennen:
'NameAlt:   DateinameAlt.xls
'NameNeu:   DateinameNeu.xls
'---------------------------------------------------------------------------------------
Function FTPUnbenennenVerschieben(NameAlt As String, NameNeu As String)
Dim result
FTPVerzeichnisErmitteln
DatenSenden "RNFR " & NameAlt & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Function
End If
DatenSenden "RNTO " & NameNeu & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Function
End If
End Function

'---------------------------------------------------------------------------------------
' Bemerkungen: Mit diesem Makro können die Rechte einer Datei/Ordner geändert werden.
'              DateiOrdner  = Name der Datei/Ordner, bei dem die Rechte geändert werden
'                             sollen
'              Rechte       = Die Rechte, die gesetzt werden sollen
'                             Achtung: Datentyp Benutzerrechte
'---------------------------------------------------------------------------------------
Function FTPRechteÄndern(DateiOrdner As String, Rechte As Benutzerrechte)
Dim NeuRechte As Integer
NeuRechte = Rechte.Eigentümer * 100 + Rechte.Gruppe * 10 + Rechte.sonstige
Dim result
DatenSenden "SITE CHMOD " & NeuRechte & " " & DateiOrdner & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Function
End If
End Function

Private Sub ProcTimer(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
Dim result
DatenSenden "NOOP" & vbCrLf, aSocket
Do Until DatenAngekommen(aSocket) > 0: Loop
result = DatenEmpfangen(aSocket)
If Left(result, 1) * 1 = 4 Or Left(result, 1) * 1 = 5 Then
    MsgBox "Fehler: " & result
    Exit Sub
End If
End Sub

Private Sub StartTimer()
Timer = SetTimer(0&, 0&, 30000, AddressOf ProcTimer)
End Sub

Private Sub LöscheTimer()
KillTimer 0&, Timer
End Sub


Funktionert der Code nicht? Dann öffnet unbedingt einen Thread dazu und schreibt mir eine PN (nur PNs, wenn es sich um dieses Makro handelt!), damit ich eure Frage auch sehe. Meistens handelt es sich um Kleinigkeiten - oder ich ahbe hier wieder vergessen, HTML zu deaktivieren und die Hälfte des Codes ist im Nirwana verschwunden Wink

Quellen:
- API-Deklarationen nach ApiViewer (teils angepasst)
- RFC 959 (Okt. 1985)

Freundliche Grüsse
Lukas

_________________
Der Optimist sieht in jedem Problem eine Aufgabe.
Der Pessimist sieht in jeder Aufgabe ein Problem.


Zuletzt bearbeitet von Lukas Mosimann am 26. Okt 2010, 14:24, insgesamt 15-mal bearbeitet
< Peter >
Excel-Moderator, der immer noch dazu lernt


Verfasst am:
22. Jun 2007, 20:08
Rufname: Kommt darauf an wer ruft
Wohnort: Das schönste Land in Deutschlands Gaun


AW: FTP - AW: FTP

Nach oben
       Version: (keine Angabe möglich)

Hallo,

nimmt den Beitrag aus den unbeantworteten heraus.

_________________
Gruß
Peter
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel VBA (Makros): FTP Download per VBA 9 tobi787 183 25. März 2014, 07:53
Case FTP Download per VBA
Keine neuen Beiträge Excel VBA (Makros): Mit Makros Datei als Website auf einem FTP Server speichern 5 asncm 164 01. Aug 2013, 14:32
MWOnline Mit Makros Datei als Website auf einem FTP Server speichern
Keine neuen Beiträge Excel VBA (Makros): Zugriff auf FTP Server 0 kuri 173 29. Jan 2013, 17:34
kuri Zugriff auf FTP Server
Keine neuen Beiträge Excel VBA (Makros): file auf ftp server öffnen 1 kuri 143 19. Jan 2013, 15:38
RO_SCH file auf ftp server öffnen
Keine neuen Beiträge Excel Hilfe: Tabelle aus Excel 2010 nicht über ftp als html exportierbar? 0 Trommler 446 21. Dez 2011, 20:32
Trommler Tabelle aus Excel 2010 nicht über ftp als html exportierbar?
Keine neuen Beiträge Excel VBA (Makros): FTP Import und automatische sortierung der Daten 0 Ovaron 151 23. Nov 2011, 08:31
Ovaron FTP Import und automatische sortierung der Daten
Keine neuen Beiträge Excel VBA (Makros): FTP,Probleme mit einem Makro aus dem Tips und Tricks bereich 14 FritzHugo3 808 07. Aug 2011, 22:15
Lukas Mosimann FTP,Probleme mit einem Makro aus dem Tips und Tricks bereich
Keine neuen Beiträge Excel Hilfe: *T*AW: FTP 1 Gast 146 01. März 2011, 22:53
Lukas Mosimann *T*AW: FTP
Keine neuen Beiträge Excel VBA (Makros): HTML via FTP uploaden 6 buckeT 399 21. Dez 2010, 13:42
toms777 HTML via FTP uploaden
Keine neuen Beiträge Excel VBA (Makros): FTP Upload aus Excel-VBA heraus 1 ChillOut 1670 15. Okt 2010, 18:09
Googlemalwieder FTP Upload aus Excel-VBA heraus
Keine neuen Beiträge Excel VBA (Makros): Mac Excel ftp Upload 0 Chacky 454 21. Sep 2010, 12:00
Chacky Mac Excel ftp Upload
Keine neuen Beiträge Excel Hilfe: *T*AW: FTP 0 RTausD 187 27. Jul 2010, 22:03
RTausD *T*AW: FTP
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Microsoft Excel Tricks