Results 1 to 9 of 9

Thread: Workbook won't open

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,476
    Location

    Workbook won't open

    I'm trying to copy the first sheet from the newest "unchecked" workbook in a folder, but the workbook fails to open.
    Caution: the code will insert the word "Read" into the document properties Keywords
    [vba]
    Option Explicit
    Option Compare Text

    Sub GetFP()
    Dim MyPath As String
    Dim fType As String
    Dim MyName As String
    Dim fDate As Date
    Dim fname As String
    Dim wb As Workbook
    Dim LastWB As Workbook
    Dim fil As String
    Set wb = ActiveWorkbook
    Set fs = CreateObject("Scripting.FileSystemObject")
    Application.EnableEvents = False
    'Set Path and files to find
    MyPath = InputBox("Enter folder", , "C:\AAB") & "\"
    fType = "*.xls"
    fil = Dir(MyPath & fType)
    MyName = MyPath & fil
    'Initialise variables
    fDate = 0: fname = ""
    'Search for workbooks in cuttent folder
    Do
    'Check for absence of Keyword "Read" (=1)
    If Test(MyPath, fil) = 0 Then
    'Ignore current file
    If MyName <> wb.FullName Then
    'Remember date and file name if newest
    Set f = fs.GetFile(MyName)
    If f.datecreated > fDate Then
    fname = MyName
    fDate = f.datecreated
    MsgBox fil
    End If
    End If
    End If
    'Get next name to check
    fil = Dir
    MyName = MyPath & fil
    'Exit loop if no file found
    Loop Until MyName = MyPath
    'Advise of file to be processed
    MsgBox "File to open - " & fname
    '*************************************
    'Open file
    Set LastWB = Workbooks.Open(fname)
    '*************************************
    'Set Keyword to "Read"; copy Sheet 1 to Active Workbook
    With LastWB
    .BuiltinDocumentProperties(4) = "Read"
    .Sheets(1).Copy Before:=wb.Sheets(1)
    End With
    'Rename copied worksheet to abbr. file name
    fil = Split(fname, "\")(UBound(Split(fname, "\")))
    wb.Sheets(1).Name = Left(fil, Len(fil) - 4)
    'Tidy up
    Application.DisplayAlerts = False
    LastWB.Close True
    Set wb = Nothing
    Set fs = Nothing
    Set LastWB = Nothing
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    End Sub

    Function Test(fpath As String, fil As String)
    With Application.FileSearch
    .NewSearch
    .LookIn = fpath
    .Filename = fil
    .TextOrProperty = "Read"
    .FileType = msoFileTypeAllFiles
    .Execute
    Test = .FoundFiles.Count
    Debug.Print Test & " - " & fil
    End With
    End Function

    [/vba]
    Last edited by mdmackillop; 08-19-2006 at 03:11 AM. Reason: Option statements added
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •