[Excel VBA] Datei Abfrage aus externem Pfad

  • Excel

Es gibt 4 Antworten in diesem Thema. Der letzte Beitrag () ist von Blaupunkt79.

    [Excel VBA] Datei Abfrage aus externem Pfad

    Hallo Zusammen,

    ich möchte aus einem externen FTP Pfad abfragen, ob eine Datei vorhanden ist.

    Das ganze hat den Hintergrund, dass ich, falls eine Datei vorhanden ist, ein Update einspielen möchte.

    Das Problem ist, dass ich bei der Dateiabfrage bereits eine Fehlermeldung bekomme, deshalb die Frage, wie kann ich aus einem externen Pfad Dateien abfragen?

    Gruß

    Unabhängig davon das FTP ein unsicheres Protokoll ist, lässt es sich über VBA bescheiden verwenden.
    Hier ist ein Beispiel für ein FTP Klasse (mit WIN API):
    office-loesung.de/ftopic400253_0_0_asc.php


    Empfehlen würde ich dir das über HTTPS zu machen.

    LG
    Das ist meine Signatur und sie wird wunderbar sein!

    Muß den Thread nochmals hochholen.

    Ich habe jetzt mal aus Deinem Link die Daten eingefügt, er zeigt mir zwar "OK" an, aber ich finde die Datei nicht auf meinem FTP Server (NAS). Scheint wohl Probleme mit dem Ordner zu haben, gebe ich ein falsches pw ein, so meckert er, dass scheint also zu funktionieren. Jemand einen Rat?

    VB.NET-Quellcode

    1. Option Explicit
    3. Const FtpIP = "XXX" ==> kann ich hier auch eine no-ip Adresse eintragen?
    4. Const FtpUser = "XXX"
    5. Const FtpPwd = "XXX"
    6. Const FtpDir = "/Upload"
    8. Private Sub CommandButton1_Click()
    9. Dim WS As Worksheet
    10. Set WS = Worksheets.Add
    11. WS.Cells(1, 1) = "Das ist ein Test"
    12. WS.Move
    13. ActiveWorkbook.SaveAs "C:\Users\Admin\Desktop\FTPUploadTest.xls"
    14. If SaveToFTP(ActiveWorkbook.FullName) Then
    15. MsgBox "OK"
    16. Else
    17. MsgBox "Nicht OK!"
    18. End If
    19. ActiveWorkbook.Close
    20. End Sub
    22. Function SaveToFTP(FileName As String) As Boolean
    23. Dim myFtp As clsFtp
    24. Dim col As Collection
    25. Dim varItem As Variant
    26. Dim ErrorStr As String
    28. Set myFtp = New clsFtp
    30. If myFtp.Connect(FtpIP, FtpUser, FtpPwd) Then
    31. myFtp.SetCurrentDirectory FtpDir
    32. myFtp.PutFile FileName, Split(FileName, "\")(UBound(Split(FileName, "\")))
    33. ErrorStr = myFtp.GetLastError
    34. If ErrorStr = "" Then
    35. SaveToFTP = True
    36. End If
    37. myFtp.DisConnect
    38. End If
    39. Set myFtp = Nothing
    40. End Function

    Mittlerweile habe ich es hinbekommen, dass meine Excel Datei per FTP abfragt, ob auf dem FTP eine "update.txt" vorhanden ist. Ist diese vorhanden, wird der Inhalt anlysiert. Das funktioniert auch soweit, aber ... wenn ich auf dem FTP den Dateinamen von "update.txt" auf "update1.txt" abändere, aktualisiert Excel das nicht, bedeutet, er findet immer noch die "update.txt", die ja eigentlich nicht mehr vorhanden ist. Starte ich Excel neu und teste wieder, dann funktioniert es und es kommt als Meldung "Kein Update verfügbar".

    Muß ich Excel bzw. diese Routine irgendwie resetten? Passive Mode ist beim FTP im Excel eingestellt.

    Was mir beim auslesen, des Fehlercodes der Routine aufgefallen ist, dass beim ersten Aufruf mit Excel, wenn alles stimmt, folgendes erscheint: "226 Transfer complete", soweit nachvollziehbar, beim zweiten Aufruf erscheint nichts mehr, ErrorStr ist quasi leer, tritt ein Fehler auf, so erscheint der Fehlercode bei jedem Aufruf, dass passt auch soweit.

    Hier mal der Code: (die Zugangsdaten etc. passen, stehen nur weiter oben im Code und sind uninteressant ;) )

    VB.NET-Quellcode

    1. Private Sub Label25_Click()
    2. Dim myFtp As clsFtp, col As Collection, varItem As Variant
    3. Dim ErrorStr As String
    4. Dim Test As String
    5. Dim p As String
    6. Dim a As String
    7. Dim s As String
    8. Dim b As String
    9. Dim strPfad9 As String
    10. Dim datei As String
    11. strPfad9 = CurDir & "\update.txt"
    12. Set myFtp = New clsFtp
    13. If myFtp.Connect(FtpIP, FtpUser, FtpPwd) Then GoTo richtig1
    14. MsgBox ("Keine Verbindung!"): GoTo zuende
    15. richtig1:
    16. myFtp.SetCurrentDirectory FtpDir
    17. myFtp.GetFile "update.txt", strPfad9, False
    18. ErrorStr = myFtp.GetLastError
    19. If ErrorStr = "" Then GoTo richtig2
    20. p = InStr(ErrorStr, " ")
    21. If p > 0 Then a = Mid(ErrorStr, 1, p - 1): b = Mid(ErrorStr, p + 1, Len(ErrorStr))
    22. If a = "226" Then GoTo richtig2
    23. MsgBox ("Kein Update verfügbar!"): GoTo zuende1
    24. richtig2:
    25. myFtp.DisConnect
    26. Set myFtp = Nothing
    27. datei = strPfad9
    28. Open datei For Input As #1
    29. Do While Not EOF(1)
    30. Line Input #1, s
    31. p = InStr(s, " ")
    32. If p > 0 Then
    33. a = Mid(s, 1, p - 1)
    34. b = Mid(s, p + 1, Len(s))
    35. If a = "#U1" Then GoTo richtig3
    36. If a = "Kein" Then GoTo zuende11
    37. End If
    39. zuende11:
    40. Loop
    41. Close #1
    42. MsgBox ("Kein Update verfügbar!"): GoTo zuende
    44. richtig3:
    45. Close #1
    46. Unload start9
    47. Load Neuigkeiten
    48. Neuigkeiten.Show
    49. GoTo zuende9
    50. zuende1:
    51. myFtp.DisConnect
    52. zuende:
    53. Set myFtp = Nothing
    54. Unload start9
    55. Load start9
    56. start9.Show
    57. zuende9:
    58. End Sub

Facebook
Telefonspende