Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Locating the max value AND performing a fn on it only | Excel Discussion (Misc queries) | |||
performing regression | New Users to Excel | |||
Performing calculations if a value is between A and B | Excel Worksheet Functions | |||
performing least squares | Excel Discussion (Misc queries) | |||
Illegal operation error while printing EXCEL or WORD Files | Excel Discussion (Misc queries) |