Solved

Open Excel, Save and Close

Posted on 2013-12-09
2
310 Views
Last Modified: 2013-12-09
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
Comment
Question by:Conernesto
2 Comments
 
LVL 35

Accepted Solution

by:
mvidas earned 500 total points
ID: 39706326
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
 

Author Closing Comment

by:Conernesto
ID: 39706985
Great code. Thank you.
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now