Überlange Dateinamen

Liebes Forum,

habe ein Problem mit dem auslesen von Festplatten, deren Dateien mit Ordner und Unterordnern größer als 255 Zeichen sind. Zufälligerweise habe ich das bemerkt, weil ich nach so einer Datei in meinem Archiv gesucht hatte. Sonst wäre mir das bestimmt nicht aufgefallen. Diese Datei ist mit- Pfad, Ordner und Unterordnern 273 Zeichen lang. Das sonderbare ist aber, dass die Datei mit dem "Total-Commander" und dem Win Explorer gefunden wird, nur nicht mit Excel / VBA. Ich habe in der "Registry" bzw. in den "Gruppenrichtlinien" den Zugriff auf überlange Dateinamen > 255 Zeichen aktiviert und trotzdem werden mit VBA hinsichtlich dieser langen Dateinamen, keine Ergebnisse erzielt. Gibt es da keine Möglichkeit in VBA das auch zu realisieren, dass diese Dateien mit eingelesen werden können?

Viele Grüße
Elfriede

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Ich verwende eine Batch-Datei mit folgender Zeile drin:
dir /b /n /s > Alle.xls
Ob das über 255 funktioniert, weiß ich nicht. hab keine so langen Pfade hier.

Danach musst du aber noch folgendes Makro drüberrumpeln lassen, weil die Umlaute usw. nicht richtig dargestellt werden.


Sub ÄÖÜ_bat()
    ' Umlaute ersetzen und Zeichen normalisieren wenn Liste der Dateien per bat ausgelesen wird
    ' dir /b > liste.txt
    ' oder
    ' dir /b /n /s > Alle.xls
    ActiveCell.EntireColumn.Select
    Selection.Replace What:="", Replacement:="Ä", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="", Replacement:="Ö", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="", Replacement:="Ü", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True

    Selection.Replace What:="", Replacement:="ä", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="", Replacement:="ö", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="³", Replacement:="ü", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True         ' das passt nicht
    ' ü geht nicht direkt, weil in Batch als "keinZeichen" Chr(129) oder Chr(252) = ³
    Selection.Replace What:=Chr(129), Replacement:="ü", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    ' das mit ü muss geprüft werden

    Selection.Replace What:="á", Replacement:="ß", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="", Replacement:="é", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="", Replacement:="è", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="£", Replacement:="ú", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="ø", Replacement:="°", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="¤", Replacement:="ñ", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="", Replacement:="ç", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True

    Selection.Replace What:="¢", Replacement:="ó", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="¡", Replacement:="í", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True

    Selection.Replace What:="x", Replacement:="x", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="x", Replacement:="x", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="x", Replacement:="x", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="x", Replacement:="x", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="x", Replacement:="x", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True

    Selection.Replace What:="ý", Replacement:="²", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True
    Selection.Replace What:="¨", Replacement:="¿", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True

End Sub

Hab ich schon lange nicht mehr verwendet und nur lose geprüft, soweit es meinen Anforderungen (deutsche Zeichen) entsprochen hat. Siehe Kommentare.

Code:

Private Declare PtrSafe Function GetShortPathNameA Lib "kernel32" ( _
        ByVal lpszLongsPfad As String, ByVal lpszShortsPfad As String, _
        ByVal cchBuffer As Long) As Long

Private Function KuerzePfad(sPfad As String) As String
  KuerzePfad = Space$(256)
  GetShortPathNameA sPfad, KuerzePfad, 255
  ShortsPfad = Left$(KuerzePfad, InStr(KuerzePfad, vbNullChar) - 1)
End Function

Sub Test()
  Dim sPfadKurz As String

  sPfadKurz = KuerzePfad("D:\Langerpfad") & "\bild 1.bmp"
  MsgBox sPfadKurz
End Sub

Private Declare Function OemToCharA Lib "user32.dll" (ByVal lpszSrc As String, ByVal lpszDst As String) As Long Public Function F_ASC_ANS(ByVal Text As String) As String OemToCharA Text, Text F_ASC_ANS = Text End Function Sub M_snb() c00 = """G:\OF\*.xls""" MsgBox F_ASC_ANS(CreateObject("wscript.shell").exec("cmd /c dir " & c00 & " /b/s").stdout.readall) End Sub

Beliebteste Forumthreads (12 Monate)

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread