Meldung wenn ein Speicherpfad nicht vorhanden

  • Excel

Es gibt 9 Antworten in diesem Thema. Der letzte Beitrag () ist von peterfido.

    Meldung wenn ein Speicherpfad nicht vorhanden

    Hallo
    Ich habe mit Hilfe von Excel und VBA eine Benutzeroberfläche gestaltet in der Nutzer Einträge eingeben können.
    Unter dem Button "Speicher" wird die Datei selber gespeichert und gleichzeitig wird diese auf eine Art Zentralrechner im Netzwerk gespeichert.
    Nun gibt es den Fall, dass der Zentralrechner nicht verfügbar ist (abgestürtzt, nicht online etc.) und somit ein Fehler kommt und das Programm im Debug Modus ist.
    Ich möchte gerne, dass die Datei selber sich normal speichert und wenn der Pfad zum Zentralcomputer verfügbar ist, dann soll diese dort auch abgelegt werden.
    Wenn der Pfad nicht erreichbar ist, dann soll einfach nur eine kurze Meldung kommen. Dazu müsste ich irgendwie den Pfad abfragen. Das ist meine bisherige Speicherfunktion.
    Danke für die Hilfe

    P:S: gerne möchte ich auch die Datei als ganzes gespeichert wird unter C: und nur der momentan bearbeitete Sheet in eine extra Datei. Wie ist das machbar?


    Visual Basic-Quellcode

    1. Application.DisplayAlerts = False
    2. ActiveWorkbook.SaveAs Filename:="C:\Users\Desktop\Testprogramm1.1.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    3. ActiveWorkbook.SaveAs Filename:="T:\Server\Produktion\Auswertungen Produktion\Datenerfassung über Tools\Testprogramm1.1.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    4. Application.DisplayAlerts = True
    Eigentlich sollte es doch dann so funktionieren:

    Visual Basic-Quellcode

    1. Dim Fso, Dateiname as String
    2. Set Fso = CreateObject("Scripting.FileSystemObject")
    3. Dateiname = "C:\Users\User\Desktop\Erfassung_Produktionsleistung.xlsm"
    4. If Fso.FileExists(Dateiname) Then
    5. ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Erfassung_Produktionsleistung.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    6. Else
    7. MsgBox "Server nicht erreichbar. Datei wurde trotzdem gespeichert", vbCritical + vbOKOnly, "FEHLER!"
    8. End If


    Irgendwie funktioniert es jedoch nicht.
    hmm funktionier irgendwie nicht richtig.

    Visual Basic-Quellcode

    1. Dim Fso, Pfadname as String
    2. Set Fso = CreateObject("Scripting.FileSystemObject")
    3. Pfadname= "C:\Users\User\Desktop\Tools und Programme"
    4. If Fso.FolderExists(Pfadname) Then
    5. ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Tools und Programme\Erfassung_Produktionsleistung.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
    6. Else
    7. MsgBox "Server nicht erreichbar. Datei wurde trotzdem gespeichert", vbCritical + vbOKOnly, "FEHLER!"
    8. End If
    Hallo,

    Folgendes funktioniert hier:

    Visual Basic-Quellcode

    1. Option Explicit
    2. Private Sub Test()
    3. Dim FSO As Object, sDateiname As String, sPfadname As String, WshShell As Object, sDokumente As String
    4. Set WshShell = CreateObject("WScript.Shell")
    5. Set FSO = CreateObject("Scripting.FileSystemObject")
    6. sDokumente = WshShell.SpecialFolders("MyDocuments")
    7. sPfadname = sDokumente
    8. sDateiname = "Erfassung_Produktionsleistung.xlsm"
    9. Err.Clear
    10. On Error Resume Next
    11. If FSO.FolderExists(sPfadname) Then
    12. ActiveWorkbook.SaveAs Filename:=sPfadname & "\" & sDateiname, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    13. If Err.Number <> 0 Then
    14. MsgBox "Fehler " & Err.Number & vbLf & Err.Description, vbCritical + vbOKOnly, "Fehler beim speichern"
    15. End If
    16. Else
    17. MsgBox sPfadname & vbLf & "Nicht vorhanden", vbCritical + vbOKOnly, "Fehler beim speichern"
    18. End If
    19. Err.Clear
    20. sPfadname = "\\192.168.2.15\public"
    21. If FSO.FolderExists(sPfadname) Then
    22. On Error Resume Next
    23. ActiveWorkbook.SaveCopyAs Filename:=sPfadname & "\" & sDateiname
    24. If Err.Number <> 0 Then
    25. MsgBox "Fehler " & Err.Number & vbLf & Err.Description, vbCritical + vbOKOnly, "Fehler beim speichern"
    26. End If
    27. Else
    28. MsgBox sPfadname & vbLf & "Nicht vorhanden", vbCritical + vbOKOnly, "Fehler beim speichern"
    29. End If
    30. On Error GoTo 0
    31. Set FSO = Nothing
    32. Set WshShell = Nothing
    33. End Sub
    Gruß
    Peterfido

    Keine Unterstützung per PN!