Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default 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.


Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Locating the max value AND performing a fn on it only Pradhan Excel Discussion (Misc queries) 3 July 22nd 09 01:09 AM
performing regression cf New Users to Excel 1 December 26th 08 04:10 PM
Performing calculations if a value is between A and B M. Nelson Excel Worksheet Functions 3 September 12th 08 04:35 PM
performing least squares Darius Blaszijk Excel Discussion (Misc queries) 5 March 19th 05 07:25 PM
Illegal operation error while printing EXCEL or WORD Files NathanRS Excel Discussion (Misc queries) 0 January 20th 05 02:23 PM


All times are GMT +1. The time now is 10:46 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"