ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Performing an operation in successives files (https://www.excelbanter.com/excel-programming/292918-re-performing-operation-successives-files.html)

Bob Phillips[_6_]

Performing an operation in successives files
 
James,

Here is some code. I have tested that my bit works, but not where it calls
into yours. I have taken some bits out of yours, where it seems to one file
specific, so you might want to check what I have done.

I have included a folder browser for you to select the directory, and I only
included Excel files.

Here's the code

Option Explicit

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Dim FSO As Object

Sub ProcessFiles()
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object


If ActiveSheet.Range("b3").Value = "N/A" Then

ActiveWorkbook.Save

Else

Set FSO = CreateObject("Scripting.FileSystemObject")

sFolder = GetFolder()
If sFolder < "" Then
Set Folder = FSO.GetFolder(sFolder)

Set Files = Folder.Files
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
YEACprint file.path
End If
Next file

End If ' sFolder < ""

End If 'ActiveSheet.Range("b3").Value = "N/A"

End Sub

Sub YEACprint(FullFileName As String)

Workbooks.Open Filename:=FullFileName, UpdateLinks:=3
ActiveWindow.Visible = False

If ActiveSheet.Name = "YearEnd" Then
With ActiveWindow
.SelectedSheets.PrintOut Copies:=1, Collate:=True
.Save
.Close
End With
ElseIf ActiveSheet.Name = "ACs" Then
ActiveWorkbook.Save
Else
MsgBox "There isn't a YearEnd Review for this Crew member"
ActiveWorkbook.Save
ActiveWindow.Close
End If

End Sub





'-------------------------------------------------------------
Function GetFolder(Optional ByVal Name As String = "Select a folder.")
As String
'-------------------------------------------------------------
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long

bInfo.pidlRoot = 0& 'Root folder = Desktop

bInfo.lpszTitle = Name

bInfo.ulFlags = &H1 'Type of directory to Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog

'Parse the result
path = Space$(512)

GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If

End Function

'----------------------------- end-script -----------------------------


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"James Amistoso" wrote in message
...
I have a macro that performs an operaion in a single file. I would like

it to do it for 59 other files as well. Is there a way to get the macro to
move to the next file in the directory. This is what I have so far:

Sub YEACprint()
'
' YEACprint Macro
' Macro recorded 10/8/2003 by James Amistoso
'

'
If ActiveSheet.Range("b3").Value = "N/A" Then
ActiveWorkbook.Save
Else
Workbooks.Open Filename:="C:\MCE20\AC\crew 01.xls", UpdateLinks:=3
ActiveWindow.Visible = False
Windows("crew 01.xls").Visible = True
End If
If ActiveSheet.Name = "YearEnd" Then
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveWorkbook.Save
ActiveWindow.Close
ElseIf ActiveSheet.Name = "ACs" Then
ActiveWorkbook.Save
Else
MsgBox "There isn't a YearEnd Review for this Crewmember"
ActiveWorkbook.Save
ActiveWindow.Close
End If

I know this is an ugly macro, but it seems to work well. I want to be

able to tell the macro to go on to the next file (crew 02.xls, up tp crew
60.xls) and perform the same operation, any help would be greatly
appreciated.




All times are GMT +1. The time now is 12:42 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com