ASCII-Text

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: ASCII-Text

15.04.2006 22:51:48

Gerhard

AW: ASCII-Text

16.04.2006 10:24:09

Ramses

AW: ASCII-Text

16.04.2006 10:30:30

Nepumuk

AW: ASCII-Text

16.04.2006 12:21:47

Gerhard

AW: ASCII-Text

16.04.2006 15:32:44

Ramses

So früh am Morgen seh ich das noch nicht :-) o.w.T

16.04.2006 15:24:22

Ramses

Hallo
probier mal
Option Explicit

Sub ASC_Datei_öffnen()
    '(C) Ramses
    Dim FileDlg As FileDialog
    Dim newName As String, oldName As String, fileName As String
    Dim Dati As Long, Qe As Long, i As Long
    Set FileDlg = Application.FileDialog(msoFileDialogFilePicker)
    With FileDlg
        .Title = "Wählen Sie eine ASC-Datei aus"
        'Environ(25) ermittelt den Aktuellen Userpfad
        'Alternativ kann hier auch die Variable vom vorherigen
        'Dialog eingesetzt werden
        '.InitialFileName = Suchpfad
        .InitialFileName = Environ(25) & "\Eigene Dateien\"
        .Filters.Clear
        .Filters.Add "Nur ASC-Dateien Tabellen", "*.asc", 1
        .FilterIndex = 1
        .ButtonName = "Datei öffnen"
        'AllowMultiSelect = False dann kann nur eine Datei gewählt werden
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewSmallIcons
        .Show
        If .SelectedItems.Count = 0 Then
            MsgBox "Sie haben keine Datei gewählt", vbCritical + vbOKOnly, "Dateifehler"
            Exit Sub
        Else
            For Dati = 1 To .SelectedItems.Count
                'Variablen erstellen
                oldName = .SelectedItems(Dati)
                newName = Left(.SelectedItems(Dati), Len(.SelectedItems(Dati)) - 4) & ".txt"
                fileName = Right(.SelectedItems(Dati), Len(oldName) - InStrRev(oldName, "\", -1))
                'Prüfen ob die Datei schon geöffnet ist
                For i = 1 To Workbooks.Count
                    If Workbooks(i).Name = fileName Then
                        MsgBox "Die Datei: "" " & fileName & " "" ist bereits geöffnet", vbOKOnly, "Abbruch"
                        Exit Sub
                    End If
                Next i
                'bereits existierende Sicherungsdatei löschen
                If Dir(newName) <> "" Then
                    Qe = MsgBox("Die Sicherungsdatei: " & newName & " existiert schon." & _
                        vbCrLf & "Soll die Datei gelöscht werden?", vbCritical + vbYesNo, "Datei vorhanden")
                    If Qe = vbYes Then
                        Kill newName
                    Else
                        MsgBox "Makro abgebrochen ohne die Datei " & newName & " zu öffnen" & vbCrLf & "und ohne eine Sicherungsdatei zu erstellen"
                        Exit Sub
                    End If
                End If
                'Kopieren der Datei als TXT File
                FileCopy oldName, newName
                'öffnen der gewählten Datei
                Workbooks.Open .SelectedItems(Dati)
                Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
                    Semicolon:=True, Comma:=True, Space:=True
            Next Dati
        End If
    End With
    Set FileDlg = Nothing
End Sub

Gruss Rainer

Hallo
Sorry, ich habe das mit deiner Office-Version nicht gesehen :-)
Das hier sollte funktionieren
Sub ASC_Datei_öffnen_compatible()
    '(C) Ramses
    Dim newName As String, oldName As String, fileName As String
    Dim Qe As Long, i As Long
    oldName = Application.GetOpenFilename("ASC Files *.asc, *.asc")
    If oldName = "" Then
        MsgBox "Keine Datei gewählt"
        Exit Sub
    End If
    newName = Left(oldName, Len(oldName) - 4) & ".txt"
    fileName = Right(oldName, Len(oldName) - InStrRev(oldName, "\", -1))
    'Prüfen ob die Datei schon geöffnet ist
    For i = 1 To Workbooks.Count
        If Workbooks(i).Name = fileName Then
            MsgBox "Die Datei: "" " & fileName & " "" ist bereits geöffnet", vbOKOnly, "Abbruch"
            Exit Sub
        End If
    Next i
    'bereits existierende Sicherungsdatei löschen
    If Dir(newName) <> "" Then
        Qe = MsgBox("Die Sicherungsdatei: " & newName & " existiert schon." & _
            vbCrLf & "Soll die Datei gelöscht werden?", vbCritical + vbYesNo, "Datei vorhanden")
        If Qe = vbYes Then
            Kill newName
        Else
            MsgBox "Makro abgebrochen ohne die Datei " & newName & " zu öffnen" & vbCrLf & "und ohne eine Sicherungsdatei zu erstellen"
            Exit Sub
        End If
    End If
    'Kopieren der Datei als TXT File
    FileCopy oldName, newName
    'öffnen der gewählten Datei
    Workbooks.Open newName
    Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=True, Comma:=True, Space:=True
End Sub

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread