Solved

Open Excel, Save and Close

Posted on 2013-12-09
2
330 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
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

[Live Webinar] The Cloud Skills Gap

As Cloud technologies come of age, business leaders grapple with the impact it has on their team's skills and the gap associated with the use of a cloud platform.

Join experts from 451 Research and Concerto Cloud Services on July 27th where we will examine fact and fiction.

Question has a verified solution.

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

This article describes a serious pitfall that can happen when deleting shapes using VBA.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa‚Ķ

623 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