Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1252to1256
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Umlaute in Dateinamen ersetzen

Umlaute in Dateinamen ersetzen
ing.grohn
Hallo Forum,
hat jemand eine Routine, die alle Umlaute in einem Verzeicnisbaum durch
die Entsprechungen ae etc ersetzt?
Bedanke mich für Eure Mühe.
Mit freundlichen Grüßen
ALbrecht

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Umlaute in Dateinamen ersetzen
24.02.2012 14:43:35
Josef

Hallo Albrecht,
achte darauf in welche Module welcher Code gehört und gib dem Klassenmodul den richtigen Namen!
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Enum SORT_BY
  Sort_by_None
  Sort_by_Name
  Sort_by_Path
  Sort_by_Size
  Sort_by_Last_Access
  Sort_by_Last_Modyfy
  Sort_by_Date_Create
End Enum

Public Enum SORT_ORDER
  Sort_Order_Ascending
  Sort_Order_Descending
End Enum

Public Type FILEINFO
  strFilename As String
  strPath As String
  lngSize As Long
  dmtLastAccess As Date
  dmtLastModify As Date
  dmtDateCreate As Date
End Type

Sub renameFiles()
  Dim strPath As String
  strPath = "E:\Temp" 'Verzeichnis
  cleanFileNames strPath
End Sub


Private Sub cleanFileNames(RootPath As String, Optional Filetype As String = "*", Optional Subfolders As Boolean = True)
  Dim objFileSearch As clsFileSearch
  Dim lngIndex As Long
  Dim strNewName As String
  
  Set objFileSearch = New clsFileSearch
  
  With objFileSearch
    .CaseSenstiv = True
    .Extension = Filetype
    .FolderPath = RootPath
    .SearchLike = "*"
    .Subfolders = Subfolders
    If .Execute(Sort_by_Last_Modyfy, Sort_Order_Descending) > 0 Then
      For lngIndex = 1 To .FileCount
        strNewName = Replace(Replace(Replace(Replace(Replace(Replace(Replace(.Files(lngIndex).strPath, "ä", "ae"), "Ä", "Ae"), "ö", "oe"), "Ö", "Oe"), "ü", "ue"), "Ü", "Ue"), "ß", "ss")
        Name CStr(.Files(lngIndex).strPath) As strNewName
      Next
    End If
  End With
  
  Set objFileSearch = Nothing
  
End Sub


' **********************************************************************
' Modul: clsFileSearch Typ: Klassenmodul
' **********************************************************************

'// Module : clsFileSearch, Klassenmodul
'// Author : NEPUMUK at http://www.office-loesung.de/ftopic148247_0_0_asc.php
'// Created : 28. Mai 2007
'// Modified :
'// Purpose : FileSearch

Option Explicit

Private Declare Function FindFirstFile Lib "kernel32.dll" Alias "FindFirstFileA" ( _
  ByVal lpFileName As String, _
  ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32.dll" Alias "FindNextFileA" ( _
  ByVal hFindFile As Long, _
  ByRef lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32.dll" ( _
  ByVal hFindFile As Long) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32.dll" ( _
  ByRef lpFileTime As FILETIME, _
  ByRef lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32.dll" ( _
  ByRef lpFileTime As FILETIME, _
  ByRef lpSystemTime As SYSTEMTIME) As Long

Private Enum FILE_ATTRIBUTE
  FILE_ATTRIBUTE_READONLY = &H1
  FILE_ATTRIBUTE_HIDDEN = &H2
  FILE_ATTRIBUTE_SYSTEM = &H4
  FILE_ATTRIBUTE_DIRECTORY = &H10
  FILE_ATTRIBUTE_ARCHIVE = &H20
  FILE_ATTRIBUTE_NORMAL = &H80
  FILE_ATTRIBUTE_TEMPORARY = &H100
End Enum

Private Const MAX_PATH = 260&
Private Const INVALID_HANDLE_VALUE = -1&

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Private Type WIN32_FIND_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
  dwReserved0 As Long
  dwReserved1 As Long
  cFileName As String * MAX_PATH
  cAlternate As String * 14
End Type

Private mlngFileCount As Long
Private mudtFiles() As FILEINFO
Private mstrFolderPath As String
Private mstrExtension As String
Private mstrSearchLike As String
Private mblnSubFolders As Boolean
Private mblnCaseSenstiv As Boolean

Friend Property Get Files(lngIndex As Long) As FILEINFO
  Files = mudtFiles(lngIndex)
End Property


Friend Property Get FileCount() As Long
  FileCount = mlngFileCount
End Property


Friend Property Let FolderPath(strFolderPath As String)
  mstrFolderPath = strFolderPath
End Property


Friend Property Let Extension(strExtension As String)
  mstrExtension = strExtension
End Property


Friend Property Let SearchLike(strSearchLike As String)
  mstrSearchLike = strSearchLike
End Property


Friend Property Let Subfolders(blnSubFolders As Boolean)
  mblnSubFolders = blnSubFolders
End Property


Friend Property Let CaseSenstiv(blnCaseSenstiv As Boolean)
  mblnCaseSenstiv = blnCaseSenstiv
End Property


Friend Function Execute(Optional enmSortBy As SORT_BY = Sort_by_None, _
    Optional enmSortOrder As SORT_ORDER = Sort_Order_Ascending) As Long

  Call FindFiles(mstrFolderPath)
  If mlngFileCount > 1 And enmSortBy <> Sort_by_None Then _
    Call prcSort(1, mlngFileCount, enmSortBy, enmSortOrder)
  Execute = mlngFileCount
End Function


Private Sub FindFiles(ByVal strFolderPath As String)
  Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strDirName As String
  On Error GoTo ErrorHandling
  If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
  lngSearch = FindFirstFile(strFolderPath & "*.*", WFD)
  If lngSearch <> INVALID_HANDLE_VALUE Then
    Call GetFilesInFolder(strFolderPath)
    If mblnSubFolders Then
      Do
        If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) Then
          strDirName = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)
          If (strDirName <> ".") And (strDirName <> "..") Then _
            Call FindFiles(strFolderPath & strDirName)
        End If
      Loop While FindNextFile(lngSearch, WFD)
    End If
    FindClose lngSearch
  End If
  Exit Sub
  ErrorHandling:
  MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
    Err.Description, vbCritical, "Fehler"
End Sub


Private Sub GetFilesInFolder(ByVal strFolderPath As String)
  Dim WFD As WIN32_FIND_DATA, lngSearch As Long, strFilename As String
  Dim udtFiletime As FILETIME, udtSystemtime As SYSTEMTIME
  On Error GoTo ErrorHandling
  If Right$(strFolderPath, 1) <> "\" Then strFolderPath = strFolderPath & "\"
  lngSearch = FindFirstFile(strFolderPath & mstrExtension, WFD)
  If lngSearch <> INVALID_HANDLE_VALUE Then
    Do
      If (WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY Then
        strFilename = Left$(WFD.cFileName, InStr(WFD.cFileName, Chr$(0)) - 1)
        If IIf(mblnCaseSenstiv, strFilename, LCase$(strFilename)) Like _
          IIf(mblnCaseSenstiv, mstrSearchLike, LCase$(mstrSearchLike)) Then
          mlngFileCount = mlngFileCount + 1
          Redim Preserve mudtFiles(1 To mlngFileCount)
          With mudtFiles(mlngFileCount)
            .strPath = strFolderPath & strFilename
            .strFilename = strFilename
            .lngSize = WFD.nFileSizeLow
            FileTimeToLocalFileTime WFD.ftCreationTime, udtFiletime
            FileTimeToSystemTime udtFiletime, udtSystemtime
            .dmtDateCreate = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime.wMonth, udtSystemtime.wDay) + _
              TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute, udtSystemtime.wSecond))
            FileTimeToLocalFileTime WFD.ftLastAccessTime, udtFiletime
            FileTimeToSystemTime udtFiletime, udtSystemtime
            .dmtLastAccess = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime.wMonth, udtSystemtime.wDay) + _
              TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute, udtSystemtime.wSecond))
            FileTimeToLocalFileTime WFD.ftLastWriteTime, udtFiletime
            FileTimeToSystemTime udtFiletime, udtSystemtime
            .dmtLastModify = CDate(DateSerial(udtSystemtime.wYear, udtSystemtime.wMonth, udtSystemtime.wDay) + _
              TimeSerial(udtSystemtime.wHour, udtSystemtime.wMinute, udtSystemtime.wSecond))
          End With
        End If
      End If
    Loop While FindNextFile(lngSearch, WFD)
    FindClose lngSearch
  End If
  Exit Sub
  ErrorHandling:
  MsgBox "Fehler " & CStr(Err.Number) & vbLf & vbLf & _
    Err.Description, vbCritical, "Fehler"
End Sub


Private Sub prcSort(lngLBorder As Long, lngUBorder As Long, enmSortBy As SORT_BY, enmSortOrder As SORT_ORDER)
  Dim lngIndex1 As Long, lngIndex2 As Long
  Dim udtBuffer As FILEINFO, vntTemp As Variant
  lngIndex1 = lngLBorder
  lngIndex2 = lngUBorder
  Select Case enmSortBy
    Case Sort_by_Name: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).strFilename
    Case Sort_by_Path: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).strPath
    Case Sort_by_Size: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).lngSize
    Case Sort_by_Last_Access: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).dmtLastAccess
    Case Sort_by_Last_Modyfy: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).dmtLastModify
    Case Sort_by_Date_Create: vntTemp = mudtFiles((lngLBorder + lngUBorder) \ 2).dmtDateCreate
  End Select
  Do
    Select Case enmSortBy
      Case Sort_by_Name
        If enmSortOrder = Sort_Order_Ascending Then
          Do While mudtFiles(lngIndex1).strFilename < vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp < mudtFiles(lngIndex2).strFilename
            lngIndex2 = lngIndex2 - 1
          Loop
        Else
          Do While mudtFiles(lngIndex1).strFilename > vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp > mudtFiles(lngIndex2).strFilename
            lngIndex2 = lngIndex2 - 1
          Loop
        End If
      Case Sort_by_Path
        If enmSortOrder = Sort_Order_Ascending Then
          Do While mudtFiles(lngIndex1).strPath < vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp < mudtFiles(lngIndex2).strPath
            lngIndex2 = lngIndex2 - 1
          Loop
        Else
          Do While mudtFiles(lngIndex1).strPath > vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp > mudtFiles(lngIndex2).strPath
            lngIndex2 = lngIndex2 - 1
          Loop
        End If
      Case Sort_by_Size
        If enmSortOrder = Sort_Order_Ascending Then
          Do While mudtFiles(lngIndex1).lngSize < vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp < mudtFiles(lngIndex2).lngSize
            lngIndex2 = lngIndex2 - 1
          Loop
        Else
          Do While mudtFiles(lngIndex1).lngSize > vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp > mudtFiles(lngIndex2).lngSize
            lngIndex2 = lngIndex2 - 1
          Loop
        End If
      Case Sort_by_Last_Access
        If enmSortOrder = Sort_Order_Ascending Then
          Do While mudtFiles(lngIndex1).dmtLastAccess < vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp < mudtFiles(lngIndex2).dmtLastAccess
            lngIndex2 = lngIndex2 - 1
          Loop
        Else
          Do While mudtFiles(lngIndex1).dmtLastAccess > vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp > mudtFiles(lngIndex2).dmtLastAccess
            lngIndex2 = lngIndex2 - 1
          Loop
        End If
      Case Sort_by_Last_Modyfy
        If enmSortOrder = Sort_Order_Ascending Then
          Do While mudtFiles(lngIndex1).dmtLastModify < vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp < mudtFiles(lngIndex2).dmtLastModify
            lngIndex2 = lngIndex2 - 1
          Loop
        Else
          Do While mudtFiles(lngIndex1).dmtLastModify > vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp > mudtFiles(lngIndex2).dmtLastModify
            lngIndex2 = lngIndex2 - 1
          Loop
        End If
      Case Sort_by_Date_Create
        If enmSortOrder = Sort_Order_Ascending Then
          Do While mudtFiles(lngIndex1).dmtDateCreate < vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp < mudtFiles(lngIndex2).dmtDateCreate
            lngIndex2 = lngIndex2 - 1
          Loop
        Else
          Do While mudtFiles(lngIndex1).dmtDateCreate > vntTemp
            lngIndex1 = lngIndex1 + 1
          Loop
          Do While vntTemp > mudtFiles(lngIndex2).dmtDateCreate
            lngIndex2 = lngIndex2 - 1
          Loop
        End If
    End Select
    If lngIndex1 <= lngIndex2 Then
      udtBuffer = mudtFiles(lngIndex1)
      mudtFiles(lngIndex1) = mudtFiles(lngIndex2)
      mudtFiles(lngIndex2) = udtBuffer
      lngIndex1 = lngIndex1 + 1
      lngIndex2 = lngIndex2 - 1
    End If
  Loop Until lngIndex1 > lngIndex2
  If lngLBorder < lngIndex2 Then Call prcSort(lngLBorder, lngIndex2, enmSortBy, enmSortOrder)
  If lngIndex1 < lngUBorder Then Call prcSort(lngIndex1, lngUBorder, enmSortBy, enmSortOrder)
End Sub



« Gruß Sepp »

Anzeige
AW: Umlaute in Dateinamen ersetzen
24.02.2012 16:10:25
ing.grohn
Hallo Sepp,
vielen Dank!
melde mich später wies geklappt hat
Mit freundlichen Grüßen
Albrecht
AW: Umlaute in Dateinamen ersetzen
24.02.2012 18:49:01
ing.grohn
Hallo Sepp,
funktioniert gut!
Allerdings läuft das Programm auf eine Fehlermeldung ("Datei nicht gefunden") wenn in einem Unterverzeichnis selbst ein Umlaut steht und Dateien vorhanden sind.
Verzeichnisse werden scheins nicht umbenannt obwohl der String davon ausgeht.
(hatte ich ja auch nicht gefragt)
Vielen Dank
Mit freundlichen Grüßen
Albrecht
(früher wollte ich immer Umlaute, jetzt stören sie mich, c' est la vie)
AW: Umlaute in Dateinamen ersetzen
24.02.2012 19:23:42
Josef

Hallo Albrecht,
das hatte ich nicht bedacht;-))
Ersetze nur diese Prozedur dann läuft es auch mit Umlauten in Verzeichnisnamen.
Private Sub cleanFileNames(RootPath As String, Optional Filetype As String = "*", Optional _
    Subfolders As Boolean = True)

  Dim objFileSearch As clsFileSearch
  Dim lngIndex As Long
  Dim strNewName As String
  
  Set objFileSearch = New clsFileSearch
  
  With objFileSearch
    .CaseSenstiv = True
    .Extension = Filetype
    .FolderPath = RootPath
    .SearchLike = "*"
    .Subfolders = Subfolders
    If .Execute() > 0 Then
      For lngIndex = 1 To .FileCount
        strNewName = _
          Replace(Replace(Replace(Replace(Replace(Replace(Replace(.Files(lngIndex).strFilename, "ä", _
          "ae"), "Ä", "Ae"), "ö", "oe"), "Ö", "Oe"), "ü", "ue"), "Ü", "Ue"), "ß", "ss")
        Name CStr(.Files(lngIndex).strPath) As _
          Left(.Files(lngIndex).strPath, InStrRev(.Files(lngIndex).strPath, "\")) & strNewName
      Next
    End If
  End With
  
  Set objFileSearch = Nothing
  
End Sub



« Gruß Sepp »

Anzeige
Nimm diesen hier!
24.02.2012 19:26:06
Josef

Hallo Albrecht,
eine kleine Optimierung.
Private Sub cleanFileNames(RootPath As String, Optional Filetype As String = "*", Optional _
    Subfolders As Boolean = True)

  Dim objFileSearch As clsFileSearch
  Dim lngIndex As Long
  Dim strNewName As String
  
  Set objFileSearch = New clsFileSearch
  
  With objFileSearch
    .CaseSenstiv = True
    .Extension = Filetype
    .FolderPath = RootPath
    .SearchLike = "*"
    .Subfolders = Subfolders
    If .Execute() > 0 Then
      For lngIndex = 1 To .FileCount
        strNewName = _
          Replace(Replace(Replace(Replace(Replace(Replace(Replace(.Files(lngIndex).strFilename, "ä", _
          "ae"), "Ä", "Ae"), "ö", "oe"), "Ö", "Oe"), "ü", "ue"), "Ü", "Ue"), "ß", "ss")
        If strNewName <> .Files(lngIndex).strFilename Then
          Name CStr(.Files(lngIndex).strPath) As _
            Left(.Files(lngIndex).strPath, InStrRev(.Files(lngIndex).strPath, "\")) & _
            strNewName
        End If
      Next
    End If
  End With
  
  Set objFileSearch = Nothing
  
End Sub



« Gruß Sepp »

Anzeige
AW: Nimm diesen hier!
24.02.2012 21:59:40
ing.grohn
Hallo Sepp,
vielen Dank!
schönes Wochenende!
Mit freundlichen Grüßen
Albrecht
AW: Umlaute in Dateinamen ersetzen
24.02.2012 17:55:43
Wilfried
Hallo!
Meinst Du es so?
Arbeitsblatt mit dem Namen 'Tabelle1'
 AB
3Ötzi Äste Über Grüße Günther, löschenOetzi Aeste Ueber Gruesse Guenther, loeschen

ZelleFormel
B3=WECHSELN(WECHSELN(WECHSELN(WECHSELN(WECHSELN(WECHSELN(WECHSELN(A3;"ß";"ss");"ä";"ae");"ö";"oe");"ü";"ue");"Ü";"Ue");"Ä";"Ae");"Ö";"Oe")
Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

Gruß
Wilfried
Anzeige
AW: Umlaute in Dateinamen ersetzen
24.02.2012 18:22:29
ing.grohn
Hallo Wilfried,
vielen Dank!
Ich wollte aber Umlaute aus Dateinamen entfernen
Mit freundlichen Grüßen
ALbrecht

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige