Ordnersuche und anschliesend Excel-Datei unbenennen... VBA

Question

Hallo liebes Forum,

ich moechte in VBA ein kleines Tool programmieren.

Ich habe in einem Verzeichniss

T:\Bank02\01_A99001\Test0323 ganz viele Ordner die von 001 bis 120 nummeriert sind. In jeden Ordner befindet sich eine Datei
die 180MPa_01.csv heist.

Nun soll mein Tool in jeden Ordner reinschauen und die Datei in den gleichen Namen wie der Ordner heist unter einem anderem Verzeichniss abspeichern.

Das sollte doch eigentlich funktioniern, aber wie?

Leider bin ich auf diesem Gebiet ein totaler Anfaenger.

Vielen Dank fuer die Hilfe im Vorraus

Answer 1

hi freak :-)

ein ansatz :-))

gruss nighty

Private strList() As String
Private ordlist() As String
Private lngCount As Long

Public Sub Einlesen()
Dim Index As Integer
Dim Eingabe As String
Dim Schalter As Boolean
lngCount = 0
SearchFiles "C:\Temp", "*.*" 'ab welchen ordner gesucht werden soll
If lngCount = 0 Then Exit Sub
For Index = 0 To UBound(ordlist)
If InStr(ordlist(Index), "GesuchterOrdner") > 0 Then
'bei fund des ordners
If InStr(strList(Index), "GesuchteDatei.xls") > 0 Then
'bei fund einer gesuchten datei des gefundenen ordners
End If
End If
Next Index
End Sub

Private Sub SearchFiles(strFolder As String, strFileName As String)
Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolder).Files
If objFile.Name Like strFileName Then
ReDim Preserve strList(lngCount)
ReDim Preserve ordlist(lngCount)
strList(lngCount) = objFile.Name
ordlist(lngCount) = strFolder
lngCount = lngCount + 1
End If
Next
For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
SearchFiles strFolder & "\" & objFolder.Name, strFileName
Next
End Sub

Answer 2

hi all :-)

wie immer korriguert :-)

gruss nighty

Private strList() As String
Private ordlist() As String
Private lngCount As Long

Public Sub Einlesen()
Dim IndexOrd As Integer
Dim IndexStr
Dim Eingabe As String
Dim Schalter As Boolean
lngCount = 0
SearchFiles "C:\Temp", "*.*" 'ab welchen ordner gesucht werden soll
If lngCount = 0 Then Exit Sub
For IndexOrd = 0 To UBound(ordlist)
For IndexStr = 0 To UBound(strList)
If InStr(ordlist(IndexOrd), "GesuchterOrdner") > 0 Then
'bei fund des ordners
If InStr(strList(IndexStr), "GesuchteDatei.xls") > 0 Then
'bei fund einer gesuchten datei des gefundenen ordners
'eventueller raussprung mit exit for
End If
End If
Next IndexStr
Next IndexOrd
End Sub

Private Sub SearchFiles(strFolder As String, strFileName As String)
Dim objFolder As Object
Dim objFile As Object
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolder).Files
If objFile.Name Like strFileName Then
ReDim Preserve strList(lngCount)
ReDim Preserve ordlist(lngCount)
strList(lngCount) = objFile.Name
ordlist(lngCount) = strFolder
lngCount = lngCount + 1
End If
Next
For Each objFolder In objFSO.GetFolder(strFolder).Subfolders
SearchFiles strFolder & "\" & objFolder.Name, strFileName
Next
End Sub