Workbook won't open

[mdmackillop]

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]

[mdmackillop]

Just a thought: Does the fact that I have previously "got" the file using FSO and not "released" it (how might I do that?) be causing the problem?

[Bob Phillips]

Malcolm,

I tried your code and did not get a problem, the latest opened fine.

I must admit to being confused by the code. I didn't examine it too much, but you are mixing Dir, FSO, and FileSearch all in the same space. Also, and potentially more of a problem, is that even though you had Option Explicit, there were two undeclared variables, fs and f.

Isn't Read a bit of ambiguous text to be using in FileSearch, it could be somweher else, in Title, subject, etc.?

[mdmackillop]

Thanks for your comments Bob,
I was working on an answer for another forum and got stuck on the File Open.
Basically, I was using FSO to return the date from files listed by the Dir command, and using FileSearch to test for a Keyword, 'cos I couldn't find any other way to get this from a closed file.
Regards
Malcolm

[Zack Barresse]

MD, instead of an InputBox for the folder, why not browse for it? http://vbaexpress.com/kb/getarticle.php?kb_id=284

[mdmackillop]

Hi Zack,
The original query was for the ActiveFolder, I through in the inputbox at the last minute. I've just seen that the request for this has been deleted.

Arising from this query though, is there another way to test for a BuiltInDocumentProperty in a closed file, other than my crude FileSearch?

[Bob Phillips]

You have to install DSO. You can get it at
http://support.microsoft.com/?id=224351
and set a reference to "DSO OLE Document Properties Reader 2.0." in the
VBIDE


[vba]


Option Explicit

Const COL_Application As String = 1
Const COL_Author As String = 2
Const COL_Version As String = 3
Const COL_Subject As String = 4
Const COL_Category As String = 5
Const COL_Company As String = 6
Const COL_Keywords As String = 7
Const COL_Manager As String = 8
Const COL_LastSavedBy As String = 9
Const COL_WordCount As String = 10
Const COL_PageCount As String = 11
Const COL_ParagraphCount As String = 12
Const COL_LineCount As String = 13
Const COL_CharacterCount As String = 14
Const COL_CharacterCountspaces As String = 15
Const COL_ByteCount As String = 16
Const COL_PresFormat As String = 17
Const COL_SlideCount As String = 18
Const COL_NoteCount As String = 19
Const COL_HiddenSlides As String = 20
Const COL_MultimediaClips As String = 21
Const COL_DateCreated As String = 22
Const COL_DateLastPrinted As String = 23
Const COL_DateLastSaved As String = 24
Const COL_TotalEditingTime As String = 25
Const COL_Template As String = 26
Const COL_Revision As String = 27
Const COL_IsShared As String = 28
Const COL_CLSID As String = 29
Const COL_ProgID As String = 30
Const COL_OleFormat As String = 1
Const COL_OleType As String = 32

Sub ListFileAttributes()
Dim FSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim Folder As Object
Dim file As Object
Dim Files As Object
Dim this As Workbook
Dim aryFiles
Dim cnt As Long
Dim sh As Worksheet

Set FSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
sFolder = "C:\MyTest"
Set Folder = FSO.GetFolder(sFolder)
Set Files = Folder.Files
cnt = 0
ReDim aryFiles(1 To 33, 1 To 1)
For Each file In Files
If file.Type = "Microsoft Excel Worksheet" Then
Call DSO(file.Path, aryFiles)
End If
Next file

On Error Resume Next
Set sh = Worksheets("ListOfFiles")
On Error GoTo 0
If sh Is Nothing Then
Worksheets.Add.Name = "ListOfFiles"
Else
sh.Cells.ClearContents
End If

For i = LBound(aryFiles, 2) To UBound(aryFiles, 2)
Cells(i + 1, "A").Value = aryFiles(COL_Author, i)
Next i
Columns("A:C").AutoFit

End Sub

Sub DSO(ByVal FileName As String, ByRef aryData)
Static notFirstTime As Boolean
Dim fOpenReadOnly As Boolean
Dim DSO As DSOFile.OleDocumentProperties
Dim oSummProps As DSOFile.SummaryProperties
Dim oCustProp As DSOFile.CustomProperty
Dim iNext As Long

If notFirstTime Then
iNext = UBound(aryData, 2) + 1
Else
iNext = UBound(aryData, 2)
notFirstTime = True
End If
ReDim Preserve aryData(1 To 33, 1 To iNext)

Set DSO = New DSOFile.OleDocumentProperties
DSO.Open FileName, fOpenReadOnly, dsoOptionOpenReadOnlyIfNoWriteAccess

'Get the SummaryProperties (these are built-in set)...
Set oSummProps = DSO.SummaryProperties
aryData(1, iNext) = oSummProps.ApplicationName
aryData(2, iNext) = oSummProps.Author
aryData(3, iNext) = oSummProps.Version
aryData(4, iNext) = oSummProps.Subject
aryData(5, iNext) = oSummProps.Category
aryData(6, iNext) = oSummProps.Company
aryData(7, iNext) = oSummProps.Keywords
aryData(8, iNext) = oSummProps.Manager
aryData(9, iNext) = oSummProps.LastSavedBy
aryData(10, iNext) = oSummProps.WordCount
aryData(11, iNext) = oSummProps.PageCount
aryData(12, iNext) = oSummProps.ParagraphCount
aryData(13, iNext) = oSummProps.LineCount
aryData(14, iNext) = oSummProps.CharacterCount
aryData(15, iNext) = oSummProps.CharacterCountWithSpaces
aryData(16, iNext) = oSummProps.ByteCount
aryData(17, iNext) = oSummProps.PresentationFormat
aryData(18, iNext) = oSummProps.SlideCount
aryData(19, iNext) = oSummProps.NoteCount
aryData(20, iNext) = oSummProps.HiddenSlideCount
aryData(21, iNext) = oSummProps.MultimediaClipCount
aryData(22, iNext) = oSummProps.DateCreated
aryData(23, iNext) = oSummProps.DateLastPrinted
aryData(24, iNext) = oSummProps.DateLastSaved
aryData(25, iNext) = oSummProps.TotalEditTime
aryData(26, iNext) = oSummProps.Template
aryData(27, iNext) = oSummProps.RevisionNumber
aryData(28, iNext) = oSummProps.SharedDocument
'Add a few other items that pertain to OLE files only...
If DSO.IsOleFile Then
aryData(29, iNext) = DSO.CLSID
aryData(30, iNext) = DSO.progID
aryData(31, iNext) = DSO.OleDocumentFormat
aryData(32, iNext) = DSO.OleDocumentType
End If

'Now the custom properties
For Each oCustProp In DSO.CustomProperties
aryData(33, iNext) = CStr(oCustProp.Value)
Next oCustProp

Set oCustProp = Nothing
Set oSummProps = Nothing
Set DSO = Nothing

End Sub
[/vba]

[mdmackillop]

Thanks Bob,
I'll have a look into that. The words "nut" and "sledgehammer" spring to mind.

[Bob Phillips]

Thanks Bob,
I'll have a look into that. The words "nut" and "sledgehammer" spring to mind.

Malcolm,

I gave you the comprehensive code. You only need to pick out the bits you need, which will be determined by your design. DSO is the 'right' way to get closed file properties.