Dateinamen Groß/Klein nicht beachten
03.05.2009 14:57:37
Thomas
ich habe vor einiger Zeit ein Makro zum einlesen von Dateien gefunden und nach meinen Bedürfnissen abgeändert. Das funktioniert, aber es gibt ein Problem.
Die Dateien die eingelesen werden sollen, werden durch ein Makro einer anderen Datei angelegt und der Dateiname durch dieses immer vergeben. Wenn man diese Dateien allerdings auf ein Netzlaufwerk kopiert, dann wird der Dateiname immer klein geschrieben. Der Dateiname setzt sich zusammen aus der Organisation - Monat Jahr (z.B. CBI - Mai 2009.xls) auf dem Netzlaufwerk wird also cbi - mai 2009.xls daraus.
Das Makro zum öffnen dieser Dateien unterscheidet aber zwischen Groß- und Kleinbuchstaben und die Dateien werden somit nicht gefunden. Jetzt habe ich den SuchNamen mit LCase in Kleinbuchstaben umgewandelt, habe dann aber wieder das Problem wenn es lokal genutzt wird, wo die Dateinamen nunmal Groß geschrieben sind.
Kann man das Makro so anpassen, das es egal ist ob der Dateiname nun Groß oder Klein geschrieben wird? Hier mal der Code:
Private Sub CommandButton1_Click()
Dim Fso, Ordner, varDatei
Dim SucheDatei$, sPfad$
Dim meCalc As Integer
Dim frage
frage = MsgBox("Sollen alle Daten vor dem Import gelöscht werden?", vbYesNo)
If frage = vbYes Then Call CommandButton3_Click
TabZahl = 0
sPfad = ThisWorkbook.Path
SucheDatei = "*" & [E4] & " " & [G4] & ".xls"
SucheDatei = LCase(SucheDatei)
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Ordner = Fso.getfolder(sPfad)
With Application
meCalc = .Calculation
.ScreenUpdating = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
For Each varDatei In Ordner.Files
If varDatei Like SucheDatei Then
vollerDateiName = varDatei
kurzerDateiName = Right$(varDatei, Len(varDatei) - InStrRev(varDatei, "\"))
TabZahl = TabZahl + 1
Call Anzeige
End If
.ScreenUpdating = True
.ScreenUpdating = False
Next varDatei
If TabZahl = 0 Then MsgBox "Keine Datei für den Monat " & [E4] & " " & [G4] & " _
vorhanden!"
.ScreenUpdating = True
.DisplayAlerts = True
.Calculation = meCalc
End With
End Sub
Private Sub Anzeige()
Dim frage
Dim Ze1 As Long, Ze2 As Long, Sp As Long
frage = MsgBox(kurzerDateiName, vbYesNo)
If frage = vbNo Then Exit Sub
Workbooks.Open Filename:=vollerDateiName
Workbooks(kurzerDateiName).Activate
Sheets("Einsatzplan").Range("T7:X161").Copy
Workbooks("Einsatzpläne.xls").Activate
[L7].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:= _
False
Workbooks(kurzerDateiName).Activate
ActiveWorkbook.Close savechanges:=False
'...hier gehts mit der Ababeitung der eingelesenen Daten weiter
End Sub