View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Rob Blatchley Rob Blatchley is offline
external usenet poster
 
Posts: 2
Default Add closed workbook filenames that meet certain criteria to a message box

Thanks Jake. Here's the code I've been using. Can your suggestion
below easily be implemented? Thanks.

Code:
Public Sub RunAll() 
     
     
     'First check to make sure folder has files
     
    Dim FolderName As String, wbName As String, r As Long, cValue As
Variant, cValue2 As Variant 
    Dim wbList() As String, wbCount As Integer, i As Integer, rsVersion
As Variant 
     
    FolderName = Sheet6.Range("B5") 
     
     
     ' create list of workbooks in foldername
    wbCount = 0 
    wbName = Dir(FolderName & "\" & "*.xls") 
     
    While wbName < "" 
        wbCount = wbCount + 1 
        ReDim Preserve wbList(1 To wbCount) 
        wbList(wbCount) = wbName 
        wbName = Dir 
         
    Wend 
     ' confirm that correct files exist within selected folder
    If wbCount = 0 Then MsgBox Prompt:="No Excel files exist in this
Directory.  Please select a different folder.", Buttons:=vbOKOnly 
    If wbCount = 0 Then Exit Sub 
     
    r = 0 
    For i = 1 To wbCount 
         
         ' confirm that files are using correct version number
         
        rsVersion = GetInfoFromClosedFile(FolderName, wbList(i),
"sheet1", "A2") 
        If rsVersion < "Version 1.0" Then 
            MsgBox Prompt:="One or more of the files in the selected
folders was not created using Version 1.0", Buttons:=vbOKOnly 
            If rsVersion < "Version 1.0" Then Exit Sub 
        End If 
         
    Next i 
     
End Sub 
 
Public Function GetInfoFromClosedFile(ByVal wbPath As String, _ 
    wbName As String, wsName As String, cellRef As String) As Variant 
    Dim arg As String 
    GetInfoFromClosedFile = "" 
    If Right(wbPath, 1) < "\" Then wbPath = wbPath & "\" 
    If Dir(wbPath & "\" & wbName) = "" Then Exit Function 
    arg = "'" & wbPath & "[" & wbName & "]" & _ 
    wsName & "'!" & Range(cellRef).Address(True, True, xlR1C1) 
    On Error Resume Next 
    GetInfoFromClosedFile = ExecuteExcel4Macro(arg) 
     
End Function


*** Sent via Developersdex http://www.developersdex.com ***