Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 337
  • Last Modified:

Open Excel, Save and Close

I have a folder in my documents called 2012 (the path is C:\MyDocuments\2012). Inside the 2012 folder are four sub foldders (Folder1,Folder2,Folder3, and Folder 4). Each of the subfolders cantain many Excel woorkbooks.

I need each Excel workbook within each subfolder opended, saved and closed. This will allow built in formulas to update. Do you have code to open, close and save each workbook in Folder1, Folder2, Folder3, and Folder4?
0
Conernesto
Asked:
Conernesto
1 Solution
 
mvidasCommented:
Conernesto,

Give the following a try. Note that in the ConernestoDirectory subroutine, there are two methods for you to use to retrieve the data. In the first one, it will look through all excel files in \MyDocuments\2012\ and all subdirectories. In the second method, it will only look in those 4 specified subdirectories.
Sub ConernestoDirectory()
 Dim vFiles() As String, i As Long
 ReDim vFiles(1, 0)
 
 
'if you want all excel files in \2012 and all subdirectories, use this format
 Call GetFilesWithDir("C:\MyDocuments\2012\", vFiles)
'or
'if you only want excel files in the 4 specified subdirectories, use this format
 Call GetFilesWithDir("C:\MyDocuments\2012\Folder1\", vFiles, False)
 Call GetFilesWithDir("C:\MyDocuments\2012\Folder2\", vFiles, False)
 Call GetFilesWithDir("C:\MyDocuments\2012\Folder3\", vFiles, False)
 Call GetFilesWithDir("C:\MyDocuments\2012\Folder4\", vFiles, False)


'loop through files, look for excel files, and open/save/close any found
 For i = 0 To UBound(vFiles, 2)
  If LCase(vFiles(1, i)) Like "*.xls" Or LCase(vFiles(1, i)) Like "*.xls?" Then
   With Workbooks.Open(vFiles(0, i) & vFiles(1, i))
    .Save
    .Close
   End With
  End If
 Next
End Sub
Function GetFilesWithDir(ByVal vPath As String, ByRef vsArray() _
  As String, Optional IncludeSubfolders As Boolean = True) As Boolean
 'You must send this a string array, ReDim'med to (1,0)
 ' (0,x) = path of file
 ' (1,x) = file name
 Dim TempStr As String, vDirs() As String, Cnt As Long, dirCnt As Long
 dirCnt = 0
 If Len(vsArray(0, 0)) = 0 Then
  Cnt = 0
 Else
  Cnt = UBound(vsArray, 2) + 1
 End If
 If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
 
 If IncludeSubfolders Then
  On Error GoTo BadDir
  TempStr = Dir(vPath, 31)
  Do Until Len(TempStr) = 0
   If Asc(TempStr) <> 46 Then
    If GetAttr(vPath & TempStr) And vbDirectory Then
     ReDim Preserve vDirs(dirCnt)
     vDirs(dirCnt) = TempStr
     dirCnt = dirCnt + 1
    End If
BadDirGo:
   End If
   TempStr = Dir
SkipDir:
  Loop
 End If
 
 On Error GoTo BadFile
 TempStr = Dir(vPath, 15)
 Do Until Len(TempStr) = 0
  ReDim Preserve vsArray(1, Cnt)
  vsArray(0, Cnt) = vPath
  vsArray(1, Cnt) = TempStr
  Cnt = Cnt + 1
  TempStr = Dir
 Loop
BadFileGo:
 On Error GoTo 0
 If dirCnt > 0 Then
  For dirCnt = 0 To UBound(vDirs)
   If Len(Dir(vPath & vDirs(dirCnt))) = 0 Then
    GetFilesWithDir vPath & vDirs(dirCnt), vsArray
   End If
  Next
 End If
 Exit Function
BadDir:
 If TempStr = "pagefile.sys" Or TempStr = "???" Then
  Debug.Print "DIR: Skipping: " & vPath & TempStr
  Resume BadDirGo
 ElseIf Err.Number = 52 Then
  Debug.Print "No read dir rights: " & vPath & TempStr
  Resume SkipDir
 End If
 Debug.Print "Error with DIR Dir: " & Err.Number & " - " & Err.Description
 Exit Function
BadFile:
 If Err.Number = 52 Then
  Debug.Print "No read file rights: " & vPath & TempStr
 Else
  Debug.Print "Error with DIR File: " & Err.Number & " - " & Err.Description
 End If
 Resume BadFileGo
End Function

Open in new window

Matt
0
 
ConernestoAuthor Commented:
Great code. Thank you.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now