Hi all,
I have a macro that list all the files in a folder in a listbox. The idea would be that when I select a file from the folder, it will show the metadata in a listbox.
I found a macro that list the metadata from a file name and path in a folder, but I would like to combine it so when I click on the file from the listbox, it shows on the second listbox.
This is the code I have so far:
Extract metadata:
Code
Option ExplicitSub ExtractMetaData()
Dim objWord As Object
Dim strProperty As Object
Dim objDoc As Object
Application.ScreenUpdating = False
Set objWord = CreateObject("Word.Application")
objWord.Visible = False
Sheets("Files").Activate
Range("a1").Offset(1, 0).Select
While Selection.Value <> ""
Set objDoc = objWord.Documents.Open(Selection & Selection.Offset(0, 1))
Sheets("Metadata").Activate
If Range("A1").End(xlDown).Row = 2 Then Range("A1").End(xlDown).Activate Else Range("A1").End(xlDown).Offset(1, 0).Activate
For Each strProperty In objDoc.BuiltinDocumentProperties
On Error Resume Next
Selection = objDoc.Name
Selection.Offset(0, 1) = strProperty.Name
Selection.Offset(0, 2) = strProperty.Value
Selection.Offset(0, 3) = Now()
Selection.Offset(1, 0).Select
Next
objDoc.Close
Sheets("Files").Activate
Selection.Offset(1, 0).Select
Wend
objWord.Quit
Set objWord = Nothing
Set objDoc = Nothing
Set strProperty = Nothing
Sheets("Metadata").Select
Range("A1").End(xlDown).Offset(1, 2).Value = "EOF"
Range("C1").Select
While Selection <> "EOF"
Selection.Offset(1, 0).Select
If Selection = "" Then
Selection.EntireRow.Delete
Selection.Offset(-1, 0).Select
End If
Wend
Selection.EntireRow.Delete
Range("A1").Select
Application.ScreenUpdating = True
End Sub
Display More
Code for the file lister:
Code
Option Explicit
Sub ListAllFile_ListBox_Forms_Training_Outlook()
Dim n As Integer
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object associated with the directory
Set objFolder = objFSO.GetFolder("C:\Temp\day\23.03.2014")
With Sheet1.ListBoxes(1)
For n = .ListCount To 1 Step -1
.RemoveItem (n)
Next
'Loop through the Files collection
For Each objFile In objFolder.Files
'If you only want the file name without file type
.AddItem Mid$(objFile.Name, 1, InStr(1, objFile.Name, ".") - 1)
'If you want the file name and the file type
.AddItem objFile.Name
Next
End With
'Free memory
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
End Sub
Display More
Greetings.