AW: Open - Fehlerbehandlung
16.05.2007 11:13:23
Erich
Hallo Swen,
ist eigentlich für den Benutzer wirklich interessant, aus welchem Grund er bestimmte Pfade nicht wählen kann?
Besser wäre, ihm in der (nicht geposteten) Funktion ordner(...) versteckte oder Systemverzeichnisse
gar nicht erst zur Auswahl anzubieten.
Die Abfrage auf Attributes = 54 reicht vermutlich nicht aus. Die 54 beinhaltet die 32 (geändert, noch nicht archiviert).
Das ist hier völlig uninteressant, die 22 (=54-32) hätte die gleiche Wirkung.
Eine Bemerkung dazu habe ich in TabellezuCad1 geschrieben.
Ich würde auf FSO und Attributes ganz verzichten (wie in TabellezuCad2).
Probier die folgenden drei Prozeduren mal aus.
(Die dritte brauchst du gar nicht, ist nur zur Info.)
Option Explicit
Sub TabellezuCad2(strName As String)
'am 20.02.2007 überarbeitet
Dim sPath As String
Dim iCol As Integer, iRow As Long, strTmp As String
' Dim strLetzteFehlerArt As String, strLetzteFehlerNummer As String '## global dekl.?
Dim intK
'Prüfen ob das Sheet vorhanden ist
If Not Worksheet_suchen("cad") Then
MsgBox "Tabellenblatt 'cad' wurde nicht gefunden"
Exit Sub
End If
'Wenn ja,... auswählen
Worksheets("cad").Select
'Frage nach Speicherort
Ordner_waehlen:
sPath = ordner("Wo soll die Datei abgelegt werden ?")
'Prüfen ob die Variable "sPath" eine Inhalt hat
If sPath = "" Then Exit Sub
If Right(sPath, 1) "\" Then sPath = sPath & "\"
'** Es wird eine Tabelle in eine cad/txt Datei gespeichert
'Datei zum Schreiben öffnen
intK = FreeFile
On Error Resume Next ' Fehlerbehandlung speziell
Open sPath & strName & ".cad" For Output As #intK
Select Case Err.Number
Case 0
Case 75, 22, 33 ' hier die Fehlernummern eintragen, die MsgBox erzeugen sollen
MsgBox "Test: Fehler " & Err & " - " & Err.Description ' ### nur zum Test
On Error GoTo 0 ' Fehlerbehandlung normal
MsgBox "Sie können in dem ausgewählten Verzeichniss nicht speichern"
GoTo Ordner_waehlen
Case Else
MsgBox "Test: Fehler " & Err & " - " & Err.Description ' ### nur zum Test
strLetzteFehlerArt = Err.Description
strLetzteFehlerNummer = Err.Number
frmFehlerInfoAnSwen.Show
Exit Sub
End Select
On Error GoTo 0 ' Fehlerbehandlung normal
'Bezugnehmen auf das Sheet damit die Befehle kürzer geschrieben werden können
'dazu müssen die Verweise mit einem Punkt vorangesetzt werden
With ActiveWorkbook.Sheets("cad")
'Festlegen der Zeile mit dem letzten Eintrag
For iRow = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
'Variable leer stellen
strTmp = ""
'festlegen der letzten beschriebenen Spalte in Zeile "iRow"
For iCol = 1 To .Cells(iRow, Columns.Count).End(xlToLeft).Column
'Zusammensetzen der Werte der einzelnen Zellen
strTmp = .Cells(iRow, iCol) & ","
Next iCol
'Schreiben des Strings ohne das letzte Komma
strTmp = Left(strTmp, Len(strTmp) - 1)
'Schreiben in die Datei
Print #intK, strTmp
Next iRow
End With
'Ausgabedatei schliessen
Close #intK
End Sub
Sub TabellezuCad1(strName As String)
'am 20.02.2007 überarbeitet
' Dim smsg As String ' ### überflüssig
Dim sPath As String
Dim iCol As Integer, iRow As Long, strTmp As String
' Dim strLetzteFehlerArt As String, strLetzteFehlerNummer As String ' ### fehlte
Dim FSyObjekt As Object, FoObjekt As Object
'Prüfen ob das Sheet vorhanden ist
If Worksheet_suchen("cad") Then ' ### = True gelöscht
'Wenn ja,... auswählen
Worksheets("cad").Select
'Frage nach Speicherort
Ordner_waehlen:
sPath = ordner("Wo soll die Datei abgelegt werden ?")
'Prüfen ob die Variable "sPath" eine Inhalt hat
If sPath "" Then
'*** prüfung der schreibberechtigung ' ### sollte in ordner() stattfinden
Set FSyObjekt = CreateObject("Scripting.FileSystemObject")
Set FoObjekt = FSyObjekt.GetFolder(sPath)
' ### Attributes 54 = 2 + 4 + 16 + 32
' ### steht für 2:verborgen 4:Systemdatei 16:Verzeichnis 32:geändert (Archivbit)
' ### 16:Verzeichnis ist eh klar, 32:geändert spielt keine Rolle
If (FoObjekt.Attributes And 2) Or (FoObjekt.Attributes And 4) Then
MsgBox "Sie können in dem ausgewählten Verzeichniss nicht speichern"
GoTo Ordner_waehlen
End If
If VBA.Right(sPath, 1) "\" Then sPath = sPath & "\"
'** Es wird eine Tabelle in eine cad/txt Datei gespeichert
'Datei virtuell öffnen
On Error GoTo Fehler ' ### HIER Fehler abfangen
Open sPath & strName & ".cad" For Output As #1
On Error GoTo 0 ' ### Fehlerbehandlung normal
'Bezugnehmen auf das Sheet damit die Befehle kürzer geschrieben werden können
'dazu müssen die Verweise mit einem Punkt vorangesetzt werden
With ActiveWorkbook.Sheets("cad")
'Festlegen der Zeile mit dem letzten Eintrag
For iRow = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
'Variable leer stellen
strTmp = ""
'festlegen der letzten beschriebenen Spalte in Zeile "iRow"
For iCol = 1 To .Cells(iRow, Columns.Count).End(xlToLeft).Column
'Zusammensetzen der Werte der einzelnen Zellen
strTmp = .Cells(iRow, iCol) & ","
Next iCol
'Schreiben des Strings ohne das letzte Komma
strTmp = Left(strTmp, Len(strTmp) - 1)
'Schreiben in die virtuelle Datei
Print #1, strTmp
Next iRow
End With
'Virtuelle Datei schliessen
Close #1
End If
End If
Exit Sub
Fehler:
strLetzteFehlerArt = Err.Description
strLetzteFehlerNummer = Err.Number
frmFehlerInfoAnSwen.Show
Exit Sub
End Sub
Sub ShowFolderInfo()
' nach AW: Schreibrechte in Ordner - von Nepumuk am 23.07.2003 12:59:52
' https://www.herber.de/ _
forum/archiv/284to288/t284315.htm#284508
Dim FSyObjekt As Object, FoObjekt As Object, intE As Integer, strE As String
Set FSyObjekt = CreateObject("Scripting.FileSystemObject")
Set FoObjekt = FSyObjekt.GetFolder("c:\programme") ' anpassen
intE = FoObjekt.Attributes
intE = 54
If intE And 1 Then strE = "schreibgeschützt "
If intE And 2 Then strE = strE & "verborgen "
If intE And 4 Then strE = strE & "Systemdatei "
If intE And 8 Then strE = strE & "Datenträgerbezeichnung "
If intE And 16 Then strE = strE & "Verzeichnis "
If intE And 32 Then strE = strE & "geändert "
If intE And 64 Then strE = strE & "Verknüpfung "
If intE And 128 Then strE = strE & "komprimiert "
strE = strE & "(" & intE & ") "
MsgBox strE
End Sub
' 0 Normale Datei
' 1 Schreibgeschützte Datei
' 2 Verborgene Datei
' 4 Systemdatei
' 8 Datenträgerbezeichnung des Laufwerks
' 16 Ordner oder Verzeichnis
' 32 Die Datei hat sich seit der letzten Sicherung geändert
' 64 Verknüpfung
'128 Komprimierte Datei
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort