Schließen
16.12.2004 07:38:10
Harry
Wie kann ich nach Programmablauf das heißt nach dem er die Daten in eine Textdatei geschrieben hatt die User Form und Excel automatisch schließen, wenn eine Excel Datei geschlossen wird kommt normalerweise die abfrage ob speichern ja oder nein diese Datei wird nie gespeichert also soll auch diese abfrage nicht mehr kommen.
Funktioniert dies überhaupt? wenn ja wie Bitte?
Hier ist noch mein Quellcode:
Sub Export()
Dim strSep As String, strDat As String, _
iCol As Byte, iRow As Integer, _
iR As Integer, iC As Byte, strTxt As String, _
strMldg As String
End Sub
'Zeigt das Erstelldatum der Textdatei
Function ErstellDat(strDatei As String)
Dim fs As Object, fso As Object
Set fs = CreateObject("scripting.filesystemobject")
Set fso = fs.getfile(strDatei)
ErstellDat = Format(fso.datecreated, "DD.MM.YYYY")
End Function
Private Sub CommandButton1_Click()
Open ThisWorkbook.Worksheets("Tabelle1").Range("A2").Value For Input As #1
Zeile = 4
Do While Not EOF(1)
Line Input #1, s
If Trim(s) <> "" Then
Zeile = Zeile + 1
If Zeile > Rows.Count Then
Sheets.Add
Zeile = 1
End If
Range("A" & Zeile) = ErstellDat(ThisWorkbook.Worksheets("Tabelle1").Range("A2").Value)
Range("B" & Zeile) = ThisWorkbook.Worksheets("Tabelle1").Range("D2").Value
Range("C" & Zeile) = Mid(s, 4, 18)
Range("D" & Zeile) = Mid(s, 26, 2)
Range("E" & Zeile) = Mid(s, 30, 3)
Range("F" & Zeile) = Mid(s, 35, 3)
Range("G" & Zeile) = Mid(s, 40, 8)
Range("H" & Zeile) = Mid(s, 50, 3)
Range("I" & Zeile) = Mid(s, 55, 5)
Range("J" & Zeile) = Mid(s, 62, 8)
Range("K" & Zeile) = Mid(s, 72, 2)
Range("L" & Zeile) = Mid(s, 76, 18)
Range("M" & Zeile) = Mid(s, 97, 18)
End If
Loop
Close #1
Open ThisWorkbook.Worksheets("Tabelle1").Range("A3").Value For Input As #1
Zeile = Cells(Rows.Count, 1).End(xlUp).Row
Do While Not EOF(1)
Line Input #1, s
If Trim(s) <> "" Then
Zeile = Zeile + 1
If Zeile > Rows.Count Then
Sheets.Add
Zeile = 1
End If
Range("A" & Zeile) = ErstellDat(ThisWorkbook.Worksheets("Tabelle1").Range("A3").Value)
Range("B" & Zeile) = ThisWorkbook.Worksheets("Tabelle1").Range("D3").Value
Range("C" & Zeile) = Mid(s, 4, 18)
Range("D" & Zeile) = Mid(s, 26, 2)
Range("E" & Zeile) = Mid(s, 30, 3)
Range("F" & Zeile) = Mid(s, 35, 3)
Range("G" & Zeile) = Mid(s, 40, 8)
Range("H" & Zeile) = Mid(s, 50, 3)
Range("I" & Zeile) = Mid(s, 55, 5)
Range("J" & Zeile) = Mid(s, 62, 8)
Range("K" & Zeile) = Mid(s, 72, 2)
Range("L" & Zeile) = Mid(s, 76, 18)
Range("M" & Zeile) = Mid(s, 97, 18)
End If
Loop
Close #1
iRow = ActiveSheet.UsedRange.Rows.Count
iCol = ActiveSheet.UsedRange.Columns.Count
'strSep = InputBox("Trennzeichen?" & vbLf & "('Abbrechen' für TAB)")
If strSep = "" Then
strSep = Chr(9)
Else
strSep = Left(Trim(strSep), 1)
End If
DateiName:
strDat = InputBox("Dateiname?", "mach_SAP.txt", ThisWorkbook.Path & "\" & "mach_SAP.txt")
'strDat = InputBox("Dateiname?", "DateiName", ThisWorkbook.Path & "\")
If strDat = "" Then Exit Sub
If InStr(strDat, ":\") = 0 Then
strDat = ThisWorkbook.Path & "\" & strDat
End If
If Dir(strDat) <> "" Then
strMldg = MsgBox("Datei bereits vorhanden. Überschreiben?", vbYesNo)
If strMldg = vbNo Then GoTo DateiName
End If
On Error GoTo DateiFehler
Open strDat For Output As #1
For iR = 5 To iRow 'Zelle ab wo Exportiert wird
strTxt = ""
For iC = 1 To iCol
strTxt = strTxt & Cells(iR, iC) & strSep
Next iC
strTxt = Left(strTxt, Len(strTxt) - 1)
Print #1, strTxt
Next iR
Close #1
MsgBox ("Die Datei " & strDat & " wurde angelegt.")
Exit Sub
DateiFehler:
MsgBox ("Fehler in Dateinamen!")
Resume DateiName
End Sub
Gruß Harry S.