Új hozzászólás Aktív témák

• #23814 slashing senior tag

  Új Válasz 2014-10-19 14:11:15 #23814

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  slashing

  senior tag

  Én találtam egy működő verziót ami a főkönyvtárban lévő almappákban lévő fájlokon végigmegy viszont az almappák almappáin nem illetve a főkönyvtárban elhelyzett fájlokon sem. Kipróbáltam

  Sub test()
  
  Dim objFSO As Object
  Dim objFolder As Object
  Dim objSubFolder As Object
  Dim objFile As Object
  Dim MyFolder As String
  Dim wkbOpen As Workbook
  Dim wkb As Workbook
  Dim wks As Worksheet
  Dim CalcMode As Long
  
  With Application
  CalcMode = .Calculation
  .Calculation = xlCalculationManual
  .ScreenUpdating = False
  .EnableEvents = False
  End With
  
  'Change the path accordingly
  MyFolder = "C:\Path"
  
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFSO.GetFolder(MyFolder)
  Set wkb = ActiveWorkbook
  Set wks = ActiveSheet
  
  For Each objSubFolder In objFolder.SubFolders
  For Each objFile In objSubFolder.Files
  Set wkbOpen = Workbooks.Open(objFile.Path)
  'Your code here
  wkbOpen.Close savechanges:=True
  Next objFile
  Next objSubFolder
  
  With Application
  .Calculation = CalcMode
  .ScreenUpdating = True
  .EnableEvents = True
  End With
  
  MsgBox "Completed...", vbInformation
  
  End Sub

  by.: Domenic (http://www.mrexcel.com)

Új hozzászólás Aktív témák