Hi Josh,
thanks for the mail.
i guess i was not very clear with my description of what i want or alternatevely what i am trying to do with the application.
well, let me try again, so that you can help me ....
i have an excel application called PDD_NP which is supposed to ask for a directory where it wants the apllication to run. PDD_NP then reads the directories and sub-directories and finds all the excel files there. PDD_NP then opens each file and checks which one of them are the ones i am interested in from the whole lot of excel files in that particular directory. i read set of values from the excel files i am interested in and then close them. i write these read values into the master "PDD_NP".
PROBLEMS :
1. sometimes a particular excel file (say slave01) does not close itself after the values have been read and hence further reading of excel files (other slave00 files in the directory) stops with slave01 open. the application doesnot hang though. now if i put this excel into a new folder and read the folder entries using PDD_NP i get the desired result and the file (slave01) closes after the values are read as desired . WEIRD !!!
2. now suppose of all the excel files which are found in the directory i am searching there is one which when opened prompts for a user input through a input box (say slave 02) and since it is not the desired excel PDD_NP should simply close this excel and ove on to the next in line. but there again PDD_NP stops any further processing and simply stops with the slave02 open.
hope i am a little clear this time. will you be able to help me now. i am attaching teh whole module which i have written in PDD_NP. i will appreciate any tips from you to improvise on my coding as well but the problems are my priority as i need PDD_NP to run on 'MyComputer'. the module is as follows
--------------------------------------------------------------------------------------------------------*
Sub GetDetails_Click()
' Macro recorded 12/06/06 by Namrata Prashar
Dim sMyDir As String
Dim sMaster As String
Dim sMsg As String
Dim sTitle As String
Dim sDefault As String
sMaster = ActiveWorkbook.Name
Call RefreshData
sMsg = "Enter the directory you wish to Search"
sTitle = "Directory"
sDefault = "Q:\Projects\mini04\juhftcjuyvcikuyb1\0 Finance Team\1 Spreadsheets\0_Central"
sMyDir = Application.InputBox(sMsg, sTitle, sDefault)
If sMyDir = "False" Then
Application.DisplayAlerts = False
Application.Quit
Else
Sheets(1).Range("A4").Value = sMyDir
Call DirSearch(sMaster, sMyDir)
End If
End Sub
***********************************************************************
Private Sub DirSearch(sMaster As String, sMyDir As String)
' Macro recorded 12/06/06 by Namrata Prashar
Dim sFileName As String
Dim i As Integer
Dim iDirLen As Integer
Dim iPddCount As Integer
iPddCount = 0
On Error Resume Next
iDirLen = Len(sMyDir)
' Search for Excel workbooks in all the folders and sub folders under the directory
' entered by the user using the input box
With Application.FileSearch
.LookIn = sMyDir
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
sFileName = .FoundFiles(i)
Call ValidateAndGetDataFromPDD(iDirLen, i, sMaster, sFileName, iPddCount)
Next i
Else
MsgBox "No Excel Workbooks found in the listed Directory"
End If
' count of Excel workbooks found in the directory
Sheets(1).Cells(2, 1).Value = iPddCount & " PDDs FOUND"
Sheets(1).Cells(1, 1).Value = iPddCount ' duplicated for coding purpose only
End With
End Sub
***********************************************************************
Private Sub ValidateAndGetDataFromPDD(iDirLen As Integer, i As Integer, sMaster As String, sFileName As String, ByRef iPddCount)
' Macro recorded 12/06/06 by Namrata Prashar
Dim sSchemeName As String
Dim sSchemeNo As String
Dim sSchemeLeader As String
Dim sSchemeStartDate As String
Dim sSchemeCommDate As String
Dim sSchemeTotal As String
Dim sSchemeAdjFactor As String
Dim sSI1, sSI2, sSI3, sSI4, sSI5, sSI6, sSI7 As String
Dim sTemp As String
Dim iLen1 As Integer
Dim iLen2 As Integer
Dim xlApp As Excel.Application
On Error Resume Next
' Get the Excel application to open the Excel workbooks for reading the required
' data and then closinig them. All display alerts or prompts to be taken care of
' like macro enabling, saving etc
Set xlApp = GetObject(, "Excel.application")
xlApp.Workbooks.Open sFileName, False, True
If Err.Number = 0 Then
If ActiveWorkbook.Sheets(1).Range("A1").Value = " Project Definition Document" Then
' Increment the count of PDD found in the search directory
iPddCount = iPddCount + 1
' The directory, sub directory and the file name to be separated to get a clear
' positioning of the Excel workbook
sTemp = Mid(sFileName, iDirLen + 1)
iLen1 = Len(ActiveWorkbook.Name)
iLen2 = Len(sTemp)
sTemp = Left(sTemp, (iLen2 - iLen1) - 1)
' Read the required data fields from the Excel workbook and store the in a
' temporary variable.
sSchemeName = Sheets(1).Range("C7").Value
sSchemeNo = Sheets(1).Range("SchemeNo").Value
sSchemeLeader = Sheets(1).Range("STL").Value
sSchemeStartDate = Sheets(1).Range("EstSancDate").Value
sSchemeCommDate = Sheets(1).Range("CommDate").Value
sSchemeTotal = Sheets(1).Range("O39").Value
sSchemeAdjFactor = Sheets(1).Range("O64").Value
' Select the appropriate scheme incedencing as per the option button selected
' in the excel sheet and store from lowest year first towards the commissioning
' year in temporary variables
If ActiveSheet.OptionButtons("Option Button 27") = 1 Then
sSI1 = Sheets(1).Range("O42").Value
sSI2 = Sheets(1).Range("P42").Value
sSI3 = Sheets(1).Range("Q42").Value
sSI4 = Sheets(1).Range("R42").Value
sSI5 = Sheets(1).Range("S42").Value
sSI6 = Sheets(1).Range("T42").Value
sSI7 = Sheets(1).Range("U42").Value
ElseIf ActiveSheet.OptionButtons("Option Button 28") = 1 Then
sSI1 = Sheets(1).Range("O43").Value
sSI2 = Sheets(1).Range("P43").Value
sSI3 = Sheets(1).Range("Q43").Value
sSI4 = Sheets(1).Range("R43").Value
sSI5 = Sheets(1).Range("S43").Value
sSI6 = Sheets(1).Range("T43").Value
sSI7 = Sheets(1).Range("U43").Value
ElseIf ActiveSheet.OptionButtons("Option Button 29") = 1 Then
sSI1 = Sheets(1).Range("O44").Value
sSI2 = Sheets(1).Range("P44").Value
sSI3 = Sheets(1).Range("Q44").Value
sSI4 = Sheets(1).Range("R44").Value
sSI5 = Sheets(1).Range("S44").Value
sSI6 = Sheets(1).Range("T44").Value
sSI7 = Sheets(1).Range("U44").Value
ElseIf ActiveSheet.OptionButtons("Option Button 30") = 1 Then
sSI1 = Sheets(1).Range("O45").Value
sSI2 = Sheets(1).Range("P45").Value
sSI3 = Sheets(1).Range("Q45").Value
sSI4 = Sheets(1).Range("R45").Value
sSI5 = Sheets(1).Range("S45").Value
sSI6 = Sheets(1).Range("T45").Value
sSI7 = Sheets(1).Range("U45").Value
ElseIf ActiveSheet.OptionButtons("Option Button 63") = 1 Then
sSI1 = Sheets(1).Range("O46").Value
sSI2 = Sheets(1).Range("P46").Value
sSI3 = Sheets(1).Range("Q46").Value
sSI4 = Sheets(1).Range("R46").Value
sSI5 = Sheets(1).Range("S46").Value
sSI6 = Sheets(1).Range("T46").Value
sSI7 = Sheets(1).Range("U46").Value
ElseIf ActiveSheet.OptionButtons("Option Button 62") = 1 Then
sSI1 = Sheets(1).Range("O47").Value
sSI2 = Sheets(1).Range("P47").Value
sSI3 = Sheets(1).Range("Q47").Value
sSI4 = Sheets(1).Range("R47").Value
sSI5 = Sheets(1).Range("S47").Value
sSI6 = Sheets(1).Range("T47").Value
sSI7 = Sheets(1).Range("U47").Value
End If
xlApp.ActiveWorkbook.Close (False)
Set xlApp = Nothing
' Enter the collected details into the master file. details stored in the
' temporary variables are directly entered into the sheet cells.
Workbooks(sMaster).Activate
With ActiveWorkbook.Sheets(1)
.Cells(9 + i, 1).Value = sTemp
.Cells(9 + i, 5).Value = sSchemeName
.Cells(9 + i, 8).Value = sSchemeNo
.Cells(9 + i, 10).Value = sSchemeLeader
.Cells(9 + i, 13).Value = sSchemeStartDate
.Cells(9 + i, 15).Value = sSchemeCommDate
.Cells(9 + i, 17).Value = sSchemeTotal
.Cells(9 + i, 20).Value = sSchemeAdjFactor
.Cells(9 + i, 22).Value = sSI1
.Cells(9 + i, 23).Value = sSI2
.Cells(9 + i, 24).Value = sSI3
.Cells(9 + i, 25).Value = sSI4
.Cells(9 + i, 26).Value = sSI5
.Cells(9 + i, 27).Value = sSI6
.Cells(9 + i, 28).Value = sSI7
End With
Else
xlApp.ActiveWorkbook.Close (False)
Set xlApp = Nothing
End If
End If
End Sub
***********************************************************************
Private Sub RefreshData()
' Macro recorded 12/06/06 by Namrata Prashar
Dim iRows As Integer
Dim iCols As Integer
' Refresh the data so that there is no overwriting or data inconsistency during
' repetative use of the Master file
For iRows = 10 To (10 + Sheets(1).Cells(1, 1).Value) Step 1
For iCols = 1 To 30 Step 1
Sheets(1).Cells(iRows, iCols).Value = " "
Next
Next
Sheets(1).Cells(1, 1).Value = 0
Sheets(1).Cells(2, 1).Value = " "
End Sub
------------------------------------------------------------------------------------------------------* |