< návrat zpět
MS Excel
Téma: Procházení všech souborů v adresáři
Zaslal/a karl 22.5.2014 18:07
Zdravím,
dá se nějakým cyklem projít všechny soubory v adresáři a pokud název vyhovuje podmínce, tak ho otevřít? Např. chci otevřít všechny soubory v adresáři "ABC", jejichž název začíná "A...".
kp57(22.5.2014 21:56)#019618 třeba takto:
Dim FilePath As String, xFile As String, FileSpec As String
FilePath = "C:\ABC\"
FileSpec = "*.xlsx"
xFile = Dir(FilePath & FileSpec)
Do Until xFile = vbNullString
If Left(xFile, 1) = "A" Then Workbooks.Open (FilePath & xFile)
xFile = Dir
Loop
citovat
AL(22.5.2014 22:07)#019619 Keď už som to spytlíkoval, tak to sem tiež dám :)
Sub OtvorSuboryVadresari()
Dim fldr As FileDialog, sItem As String, strF As String, wb As Workbook
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Vyber adresar"
.AllowMultiSelect = False
' .InitialFileName = strPath
If .Show <> -1 Then
MsgBox "Nezvolil si adresar"
GoTo Label_1
Else: sItem = .SelectedItems(1)
End If
End With
strF = Dir(sItem & "\A*.xl*")
Do While strF <> vbNullString
Set wb = Workbooks.Open(sItem & "\" & strF)
strF = Dir()
Loop
Set wb = Nothing
Label_1:
Set fldr = Nothing
End Subcitovat
karl(25.5.2014 18:59)#019659 Děkuji, použil jsem to od KP, ale mám ještě jeden problém. Po zpracování souboru, který vyhovuje podmínce (název "A",jej potřebuji přejmenovat tak, aby už podmínce nevyhovolal např. na "xA".
citovat
AL(25.5.2014 23:27)#019663 Šlo by to napr. takto:
Niekde za
If Left(xFile, 1) = "A" Then Workbooks.Open (FilePath & xFile), t.j. v momente, kedy bude daný workbook ešte aktívny, ale až po tom, čo ho už spracuješ, volaj nasledujúcu rutinu:
Sub Premenuj()
Dim wb As Workbook, oldName As String
Set wb = ActiveWorkbook
With wb
oldName = .Path & "\" & .Name
.SaveAs Filename:="x" & .Name
End With
Kill oldName
Set wb = Nothing
End Subalebo takto:
Sub Premenuj1()
Dim wb As Workbook, oldName As String, newName As String
Set wb = ActiveWorkbook
With wb
oldName = .Path & "\" & .Name
newName = .Path & "\x" & .Name
.Close
End With
Name oldName As newName
Set wb = Nothing
End Subcitovat