Text-Dateien umbenennen, Multiselect?

Hallo,
ich habe folgendes Problem. Ich würde gerne alle Text-Dateien in einem Ordner umbenennen (ich weiß nicht ob sich da GetOpenFile mit Multiselect:=True anbietet). Die ursprünglichen Namen der Text-Dateien lauten z. B. "11390226.TXT"
Nun soll der neue Namen aus dem Inhalt derjenigen Text-Datei generiert werden.
Inhalt der Text-Datei:
Date:
Time:
.
.
Name: T
Bezeichnung: 20
.
.
Als Trennzeichen wird Tab verwendet. Der neue Namen soll aus der 6. und 7. Zeile erfolgen so z.B. T_20.TXT
Manche Namen sind doppelt vergeben und statt sie zu überschreiben müsste dann der Name fortlaufend nummeriert werden z.B. T_20_1.TXT, T_20_2.TXT ...
Ist diese ganze Prozedur mit einmal zu erledigen und wenn ja wie muss ich vorgehen?
Vielen Dank im Voraus!
mfg
Thomas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Thomas,
teste mal.

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub renameTextFiles()
  Dim strPath As String
  Dim strTmp As String, strName As String
  Dim FF As Integer, lngIndex As Long
  Dim objFSO As Object, objFile As Object, objFolder As Object
  
  strPath = "E:\Temp\Test2" 'Verzeichnis - Anpassen!
  
  strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  
  Set objFolder = objFSO.GetFolder(strPath)
  
  For Each objFile In objFolder.Files
    If objFile.Name Like "*.txt" Then
      strName = ""
      lngIndex = 0
      FF = FreeFile
      Open objFile.Path For Input As #FF
      Do While Not EOF(FF)
        lngIndex = lngIndex + 1
        Line Input #FF, strTmp
        If lngIndex = 6 Then
          strName = Split(strTmp, vbTab)(1) & "_"
        ElseIf lngIndex = 7 Then
          strName = strName & Split(strTmp, vbTab)(1) & ".txt"
          Exit Do
        End If
      Loop
      Close #FF
      If Len(strName) Then
        strName = nextIndexName(objFile.ParentFolder.Path & "\" & strName)
        Name objFile.Path As strName
      End If
    End If
  Next
  
  Set objFile = Nothing
  Set objFolder = Nothing
  Set objFSO = Nothing
End Sub


Private Function nextIndexName(ByVal FilePath As String, Optional ByVal StartIndex As Long = 1, Optional ByVal Numbers As Long = 1) As String
  Dim strFile As String, strExt As String, strTmp As String, strFormat As String, lngCount As Long
  Dim objFSO As Object
  
  strFormat = String(Numbers, "0")
  lngCount = StartIndex
  
  strFile = Left(FilePath, InStrRev(FilePath, ".") - 1)
  strExt = Mid(FilePath, InStrRev(FilePath, "."))
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  
  strTmp = strFile & strExt
  
  Do While (objFSO.FileExists(strTmp))
    strTmp = strFile & "_" & Format(lngCount, strFormat) & strExt
    lngCount = lngCount + 1
  Loop
  
  nextIndexName = strTmp
End Function

« Gruß Sepp »

Sub renameTextFiles() Dim strPath As String Dim strTmp As String, strName As String Dim FF As Integer, lngIndex As Long Dim objFSO As Object, objFile As Object, objFolder As Object strPath = "E:\Temp\Test2" 'Verzeichnis - Anpassen! strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\") Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(strPath) For Each objFile In objFolder.Files If objFile.Name Like "*.txt" Then strName = "" lngIndex = 0 FF = FreeFile Open objFile.Path For Input As #FF Do While Not EOF(FF) lngIndex = lngIndex + 1 Line Input #FF, strTmp strTmp = Replace(strTmp, vbTab, "") If lngIndex = 6 Then strName = Trim$(Split(strTmp, ":")(1)) & "_" ElseIf lngIndex = 7 Then strName = strName & Trim$(Split(strTmp, ":")(1)) & ".txt" Exit Do End If Loop Close #FF If Len(strName) Then strName = nextIndexName(objFile.ParentFolder.Path & "\" & strName) Name objFile.Path As strName End If End If Next Set objFile = Nothing Set objFolder = Nothing Set objFSO = Nothing End Sub

Sub renameTextFiles() Dim strPath As String Dim strTmp As String, strName As String Dim FF As Integer, lngIndex As Long Dim objFSO As Object, objFile As Object, objFolder As Object strPath = "E:\Temp\Test2" 'Verzeichnis - Anpassen! strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\") Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(strPath) For Each objFile In objFolder.Files If LCase(objFile.Name) Like "*.txt" Then strName = "" lngIndex = 0 FF = FreeFile Open objFile.Path For Input As #FF Do While Not EOF(FF) lngIndex = lngIndex + 1 Line Input #FF, strTmp strTmp = Replace(strTmp, vbTab, "") If lngIndex = 6 Then strName = Trim$(Split(strTmp, ":")(1)) & "_" ElseIf lngIndex = 7 Then strName = strName & Trim$(Split(strTmp, ":")(1)) & ".txt" Exit Do End If Loop Close #FF If Len(strName) Then strName = nextIndexName(objFile.ParentFolder.Path & "\" & strName) Name objFile.Path As strName End If End If Next Set objFile = Nothing Set objFolder = Nothing Set objFSO = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Text-Dateien umbenennen, Multiselect?

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread