Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
956to960
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
956to960
956to960
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Dateinamen ändern

Dateinamen ändern
09.03.2008 13:54:00
Markus
Für folgende Aufgabe brauche ich eine Lösung:
In einer Excel-Tabelle steht zeilenweise in einer Zelle ( z.B. B10) ein Dateiname (ohne Endung wie pdf, tiff, …) z.B.: B12345 (immer 6-stellig) und zusätzlich in einer benachbarten Zelle (z.B. A10) die Eintragsnummer z.B.: 1.12.
VBA soll nun die Datei im Verzeichnis C:\temp suchen, sie heißt jedoch z.B. B1234502-1.pdf (10-stellig; -1 ist die Revisionsnummer des Dokumentes). Dann das -1 aus dem Dateinamen in eine weitere benachbarte Zelle (z.B. C10) der Tabelle zurückschreiben und die Datei auf C:\temp umbenennen in 1.12_B12345-1.pdf also die Eintragsnummer hinzufügen und das 02 (=7te und 8te Stelle) entfernen. Das soll mit jedem Zeileneintrag nacheinander geschenen (z.B. Zeile 10 bis 100).
Hat da jemand was für mich?

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Dateinamen ändern
09.03.2008 14:25:00
Tipp!
Hi,
Anrede
Frage
Gruß
mfg Tipp

AW: Dateinamen ändern
09.03.2008 20:18:30
Erich
Hallo Markus, [Dies ist eine Anrede.]
probier mal

Option Explicit
Sub Umbenenne()
Dim zz As Long, strA As String, strN As String, ii As Integer
Const strVz As String = "C:\temp\"
zz = 9                                 ' ab Zeile 10
While Not IsEmpty(Cells(zz + 1, 2))
zz = zz + 1
strA = Dir(strVz & Left(Cells(zz, 2), 6) & "*.*")
If strA > "" Then
'         Cells(zz, 6) = strA    ' nur für Test
ii = InStrRev(strA, ".")
If ii > 0 Then
strN = Cells(zz, 1) & "_" & Left(strA, 6) & Right(strA, Len(strA) + 3 - ii)
Else
strN = Cells(zz, 1) & "_" & Left(strA, 6) & Right(strA, 2)
End If
'         Cells(zz, 7) = strN    ' nur für Test
If Dir(strVz & strN) > "" Then
Cells(zz, 3) = strN & " schon vorh."
Else
Cells(zz, 3) = Mid(strA, 9, 2)
Name strVz & strA As strVz & strN
End If
Else
Cells(zz, 3) = "fehlt"
End If
Wend
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort [Dies ist ein Gruß.]

Anzeige
AW: Dateinamen ändern
12.03.2008 19:55:06
Markus
Hallo Erich,
das klappt ja gleich auf Anhieb. Danke.
Eine gute Erweiterung wäre noch, dass wenn bei einem zweiten Programmlauf die Spalt für die Revisionsnummer nicht mit "fehlt" gefüllt wird. Das würde also erfordern, dass das Programm sowohl mit dem ursprünglichen als auch mit dem neuen Dateinamen zum gleichen Ergebnis führt.
Das ist hilfreich weil die Dateien auf C:\temp manuell kopiert werden und dabei auch schon mal einige vergessen werden können. Darauf wird sehr schön mit "fehlt" hingewiesen aber nach dem Ergänzen der Dateien auf C:\temp und einem zweiten Programmlauf um den Rest auch abzuarbeiten wird das erreichte Ergebnis zu nichte gemacht.
Vielleicht bis dann und mit Dank im voraus
Markus aus Metelen

Anzeige
AW: Dateinamen ändern
13.03.2008 11:22:59
Erich
Hallo Markus,
probier mal:

Option Explicit
Sub Umbenenne2()
Dim zz As Long, strA As String, strN As String, ii As Integer
Const strVz As String = "C:\temp\"
zz = 9                                 ' ab Zeile 10
While Not IsEmpty(Cells(zz + 1, 2))
zz = zz + 1
If IsEmpty(Cells(zz, 3)) Or Cells(zz, 3) = "fehlt" Then
strA = Dir(strVz & Left(Cells(zz, 2), 6) & "*.*")
If strA > "" Then
'            Cells(zz, 6) = strA    ' nur für Test
ii = InStrRev(strA, ".")
If ii > 0 Then
strN = Cells(zz, 1) & "_" & Left(strA, 6) & Right(strA, Len(strA) + 3 - ii)
Else
strN = Cells(zz, 1) & "_" & Left(strA, 6) & Right(strA, 2)
End If
'            Cells(zz, 7) = strN    ' nur für Test
If Dir(strVz & strN) > "" Then
Cells(zz, 3) = strN & " schon vorh."
Else
Cells(zz, 3) = Mid(strA, 9, 2)
Name strVz & strA As strVz & strN
End If
Else
Cells(zz, 3) = "fehlt"
End If
End If
Wend
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Dateinamen ändern
16.03.2008 11:11:00
Markus
Hallo Erich,
das klappt nun wie ich's wollte. Besten Dank!!
Gruß und noch ein schönes Restwochenende
Markus

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige