Makro zum umschreiben des Workbooknamen!

Hallo an alle,
ich habe Datein die wie folgt heißen
CPT_0001.wk1
CPT_0002.wk1
etc.
diese Datein liegen in einem Pfad
D:/Daten/
ab hier gibt es dann verschiedene
Unterordner in den die CPT_0001 etc. Datein liegen!
Und jetzt was ich gerne hätte,
ich würde gerne alle Unterordner in D:/Daten/ durchsuchen und nach
alle Datein suchen die mit CPT anfangen und die Dateiendung haben .wk1!
Wenn er dann eine Datei findet mit der Dateiendung wk1 und wo der Dateiname mit CPT_ anfängt soll er diese öffnen und als xls Datei und dem Namen der sich wie folgt zusammensetzen soll
Zelleninhalt(C32)& "-" & Zelleninhalt(C9) & "-" & Zelleninhalt(F9) & ".xls"
abspeichern!
Am ende soll es in dem Unterordner dann die Datei einmal mit dem
Namen CPT_ usw. liegen und einmal als (siehe Namensgebung).xls Datei!
Wenn er dann die Daten überschrieben hat dann soll er
beide datein xls und wk1 wieder schließen und die nächste nehmen
im ordner!
Hier ein Beispiel des Daten Ordners!
https://www.herber.de/bbs/user/31588.zip
Kann mir jemand da bei helfen da ich da überhaupt keine idee habe!
Gruß
Swen

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Swen,
Das Makro schaut so aus:


Sub WK1_Konvertieren()
Dim Pfad As String, Dateiname_XLS As String, Verzeichnisse(1 To 1000) As String
Dim Datei_WK1 As String, Verzeichnis As String, I As Integer, J As Integer
' Unterverzeichnisse einlesen
I = 0
Verzeichnis = Dir("C:\Daten" & "\*.*", vbDirectory)
Do
I = I + 1
Verzeichnisse(I) = Verzeichnis
Verzeichnis = Dir
Loop Until Verzeichnis = ""
' WK1 Dateien öffnen und im EXCEL-Format speichern
For J = 1 To I
Pfad = "C:\Daten" & "\" & Verzeichnisse(J)
Datei_WK1 = Dir(Pfad & "\" & "CPT*.wk1")
Do Until Datei_WK1 = ""
Application.Workbooks.Open (Pfad & "\" & Datei_WK1)
Dateiname_XLS = Pfad & "\" & Mid(ActiveSheet.Range("B32").Value, _
Application.WorksheetFunction.Search(": ", ActiveSheet.Range("B32").Value, 1) + 2)
Dateiname_XLS = Dateiname_XLS & "-" & Format(CDate(Range("C9").Value), "YYYYMMDD")
Dateiname_XLS = Dateiname_XLS & "-" & Format(CDate(Range("F9")), "hhmmss") & ".xls"
ActiveWorkbook.SaveAs FileName:=Dateiname_XLS, FileFormat:=xlWorkbookNormal
ActiveWorkbook.Close
Datei_WK1 = Dir
Loop
Next J
End Sub

Bei der automatischen Erstellung des Dateinamens für die EXCEL-Dateien gab es aber einige Probleme (Ich arbeite mit ExceL97 unter Win98):
1. Zelle C32 in den WK1-Dateien ist leer. Ich nehme an Du wolltest die Kennziffer nach dem Doppelpunkt aus Zelle B32 als 1. Teil des Dateinamens.
2. Beim Speichern sind im Dateinamen die Zeichen "/" und ":" nicht zulässig. Ich habe deshalb die Datumsangabe aus Zelle C9 und die Zeitangabe aus Zelle F9 für den Dateinamen umformatiert. Datum: YYYYMMDD, Zeit: hhmmss. Diese Formate kannst Du natürlich noch anpassen und um für Dateinamen zulässige Trennzeichen ergänzen.
Gruß
Franz

Beliebteste Forumthreads (12 Monate)

Makro zum umschreiben des Workbooknamen!

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread