With Application.FileSearch

Hallo zusammen,

ich weiß dieses Thema wurde hier schon zich mal besprochen.
Leider muss ich nochmal nachfragen ob jemand helfen kann.
Ein Ex-Mitarbeiter hat uns eine File hinterlassen die natürlich jetzt nicht lauffähig ist.
Könnte mir da jemand helfen? Ich habe absolut keine Ahnung davon und würden gern diese File weiter nutzen wollen auf neueren Systemen.

Sub ordnerwahl(ByRef dateiwahl As Variant)



Dim dateipfad As String





'stellt den nächst höheren Ordner als Directory für den Explorer ein

curpath = ActiveWorkbook.Path

For z = Len(curpath) To 1 Step -1

    If Mid(curpath, z, 1) = "\" Then Exit For

Next z                                  'z ist Position des letzten "\"

upperpath = Mid(curpath, 1, z - 1)        'ist der String des nächst höheren Verzeichnisses

drive = Left(upperpath, 3)

ChDrive drive

ChDir upperpath





'öffnet das Explorerfenster lässt eine Dateiauswahl zu

dateiwahl = Application.GetOpenFilename(, , "Spektrum wählen", "auswählen", False)





'wenn der Benutzer nicht abbricht oder das Explorerfenster schließt gehts weiter

If dateiwahl > False Then      'False ist der Rückgabewert wenn der Benutzer "Abbruch" klickt

    dateipfad = dateiwahl

    

    'ermittelt den Verzeichnis-String in dem die gewählte Datei liegt

    For z = Len(dateipfad) To 1 Step -1

        If Mid(dateipfad, z, 1) = "\" Then Exit For

    Next z                                  'z ist Position des letzten "\"

    verzeichnis = Mid(dateipfad, 1, z)      'ist der String des Verzeichnisses

        



        

    'sucht alle Dateien im gewählten Ordner und listet nur diejenigen mit ".txt" am Ende

    With Application.FileSearch

        .NewSearch

        .LookIn = verzeichnis

        .Filename = "*.txt"

        .SearchSubFolders = False

        .Execute

        nFiles = .FoundFiles.Count

        

        

        'es werden nur Dateien übernommen, die NICHT "_p" oder "Proto" im Dateinamen haben

        '-> zB "Protokoll.txt" und "_prt.txt" werden nicht übernommen

        sonderzfound = ""

                

        For i = 1 To nFiles

        

            'erstmal Dateinamen extrahieren

            Pfad = .FoundFiles(i)

            For z = Len(Pfad) To 1 Step -1

                If Mid(Pfad, z, 1) = "\" Then Exit For

            Next z

            Dateiname = Right(Pfad, Len(Pfad) - z)

        

            If InStr(1, Dateiname, "_p") = 0 And _

                    InStr(1, Dateiname, "Proto") = 0 And _

                    filecheck(.FoundFiles(i)) = "" Then

                Sheets(3).Cells(i, 1) = .FoundFiles(i)                'Ablage der Dateinamen im dritten Arbeitsblatt

            Else

                If filecheck(.FoundFiles(i)) > "" Then sonderzfound = sonderzfound & filecheck(.FoundFiles(i))

            End If

        Next i

     

     End With

     

     sonderztext = ""

     sonderz = """""!§$%&/()=?´°^`²³{[]}~+*#',;>|µ@"

     If sonderzfound > "" Then

        For i = 1 To Len(sonderz)

            If InStr(1, sonderzfound, Mid(sonderz, i, 1)) > 0 Then sonderztext = sonderztext & Mid(sonderz, i, 1)

        Next i

     

        output = MsgBox("Folgende Sonderzeichen sind" & Chr(13) & _

                        "im Dateipfad nicht zulässig!" & Chr(13) & Chr(13) & _

                        sonderztext, vbOKOnly, "Sonderzeichen")

     End If

     

End If



End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Dateiname = Dir(verzeichnis & "*.txt") Do While Dateiname > "" i = i + 1 If InStr(1, Dateiname, "_p") = 0 And _ InStr(1, Dateiname, "Proto") = 0 And _ filecheck(verzeichnis & "\" & Dateiname) = "" Then Sheets(3).Cells(i, 1) = verzeichnis & "\" & Dateiname 'Ablage der Dateinamen im dritten Arbeitsblatt Else If filecheck(verzeichnis & "\" & Dateiname) > "" Then sonderzfound = sonderzfound & filecheck(verzeichnis & "\" & Dateiname) End If Dateiname = Dir Loop

Sub ordnerwahl(ByRef dateiwahl As Variant) Dim dateipfad As String Dim Datei As String Dim Erg As String Dim FoundFiles 'stellt den nächst höheren Ordner als Directory für den Explorer ein curpath = ActiveWorkbook.Path For Z = Len(curpath) To 1 Step -1 If Mid(curpath, Z, 1) = "\" Then Exit For Next Z 'z ist Position des letzten "\" upperpath = Mid(curpath, 1, Z - 1) 'ist der String des nächst höheren Verzeichnisses drive = Left(upperpath, 3) ChDrive drive ChDir upperpath 'öffnet das Explorerfenster lässt eine Dateiauswahl zu dateiwahl = Application.GetOpenFilename(, , "Spektrum wählen", "auswählen", False) 'wenn der Benutzer nicht abbricht oder das Explorerfenster schließt gehts weiter If dateiwahl > False Then 'False ist der Rückgabewert wenn der Benutzer "Abbruch" klickt dateipfad = dateiwahl 'ermittelt den Verzeichnis-String in dem die gewählte Datei liegt For Z = Len(dateipfad) To 1 Step -1 If Mid(dateipfad, Z, 1) = "\" Then Exit For Next Z 'z ist Position des letzten "\" verzeichnis = Mid(dateipfad, 1, Z) 'ist der String des Verzeichnisses 'sucht alle Dateien im gewählten Ordner und listet nur diejenigen mit ".txt" am Ende Datei = Dir(verzeichnis & "*.txt") Do Until Datei = "" nFiles = nFiles + 1 Erg = Erg & vbLf & verzeichnis & Datei Datei = Dir Loop FoundFiles = Split(Mid(Erg, Len(vbLf) + 1), vbLf) 'es werden nur Dateien übernommen, die NICHT "_p" oder "Proto" im Dateinamen haben '-> zB "Protokoll.txt" und "_prt.txt" werden nicht übernommen sonderzfound = "" For i = 1 To nFiles 'erstmal Dateinamen extrahieren Pfad = FoundFiles(i) For Z = Len(Pfad) To 1 Step -1 If Mid(Pfad, Z, 1) = "\" Then Exit For Next Z Dateiname = Right(Pfad, Len(Pfad) - Z) If InStr(1, Dateiname, "_p") = 0 And _ InStr(1, Dateiname, "Proto") = 0 And _ filecheck(FoundFiles(i)) = "" Then Sheets(3).Cells(i, 1) = FoundFiles(i) 'Ablage der Dateinamen im dritten Arbeitsblatt Else If filecheck(FoundFiles(i)) > "" Then sonderzfound = sonderzfound & filecheck(FoundFiles(i)) End If Next i sonderztext = "" sonderz = """""!§$%&/()=?´°^`²³{[]}~+*#',;>|µ@" If sonderzfound > "" Then For i = 1 To Len(sonderz) If InStr(1, sonderzfound, Mid(sonderz, i, 1)) > 0 Then sonderztext = sonderztext & Mid(sonderz, i, 1) Next i output = MsgBox("Folgende Sonderzeichen sind" & Chr(13) & _ "im Dateipfad nicht zulässig!" & Chr(13) & Chr(13) & _ sonderztext, vbOKOnly, "Sonderzeichen") End If End If End Sub

Sub import(ByVal Pfad) 'importiert die Daten aus der gewählten Textdatei 'der Pfad wird von der aufrufenden Routine hierher übergeben pfadbefehl = "TEXT;" & Pfad With Sheets(2).QueryTables.Add(Connection:=pfadbefehl, _ Destination:=Sheets(2).Cells(1, 1)) .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = xlWindows .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = False .TextFileColumnDataTypes = Array(1, 1, 1) .Refresh BackgroundQuery:=False End With 'hiernoch die Punkte in Komma verwandeln, 'falls das System auf Deutsch eingestellt ist decsep = Application.International(xlDecimalSeparator) If decsep = "," Then With Sheets(2) lastrow = .Cells(Rows.Count, 1).End(xlUp).Row For i = 7 To 20 .Cells(i, 1) = Replace(.Cells(i, 1), ".", ",") Next i For i = 23 To lastrow .Cells(i, 1) = CDbl(Replace(.Cells(i, 1), ".", ",")) .Cells(i, 2) = CDbl(Replace(.Cells(i, 2), ".", ",")) .Cells(i, 3) = CDbl(Replace(.Cells(i, 3), ".", ",")) Next i End With End If End Sub

Hallöchen,

in diesem neuen Makro ist nicht ersichtlich, wo und wie Pfad gebildet wird und entsprechend auch nicht, was da drin steht.
In Deinem ersten geposteten Makro steht zwar so eine Meldung, aber da sieht man keinen Zusammenhang zum letzten Makro.

Egal zu welchem Makro könnte man auch die Frage stellen, warum keine () enthalten sein dürfen. Das Filesystem stören die nicht. Einige andere der definierten Sonderzeichen sind ebenfalls zulässig. Du siehst es ja an der zweiten Meldung mit dem Fehler 1004.

Wobei das, falls erforderlich, das Problem nicht löst. Dort stehen andere Ursachen - womit wir wieder bei der Frage sind, was im Pfad steht. Da kommen dann Zusatzfragen wie z.B. ob es die Datei, die da drin steht, auch gibt. Wobei Pfad dann nicht nur der Pfad an sich, sondern auch der Dateiname sein müsste. Da kann man z.B. auch schauen, ob da nicht ein Backslash zwischen Pfad und Dateiname fehlt ....

Ein Ex-Mitarbeiter hat uns eine File hinterlassen die natürlich jetzt nicht lauffähig ist.
Könnte mir da jemand helfen? Ich habe absolut keine Ahnung davon und würden gern diese File weiter nutzen wollen auf neueren Systemen.

Eventuell wäre es besser, wenn Du bzw. Dein Chef / die Firma die Anpassung beauftragst. Du merkst es ja am Verlauf dieses Threads ... Da kann man dann auch die Geheimhaltung von Firmendaten absichern und ggf. auch weitere Dateien und Daten senden, z.B. die, auf die da zugegriffen werden soll, ein Abbild der Ordnerstruktur usw.

Ansonsten, wenn Habe mich versucht zu belesen aber wenn man keine ahnung hat bringt mir das nicht viel. und Du das weiterhin selbst lösen willst, dann wäre ggf. erst mal ein VBA-Kurs nicht verkehrt.

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

With Application.FileSearch

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread