Generate automatic ids - vba

I have to do the following:
Open mail -> Check Subject -> If subject is not like : ..... cID#[4digit] -> Add a cID#[4digit] to it, based on other mail's subjects in your folders and sub-folders -> other operations.
Basically check for the highest value of cID#, increment it by 1, and add it to the new subject. For example if your subject is: H&H 2013 allocation.
-It checks if the subject contains the cID# part.✓
-It can't find it, so it checks the folders, and sub-folders for the highest cID#; increment it by 1. ✗
Getting the ID of a single mail as integer is done, because it is just the Val(Right(subjectstring.4)) (It will always be on the right, which is easier for me, because I couldn't find other methods, but they are more than welcome) From these values, it is easy to build the 4 length long string, and insert it to the subject.
My question is, how to get the highest valued cID#-s.

Following Max's advice, my code is based on this, if anyone else has the same problem.
I use the szamid's to set the numbers.
Sub readtextfile()
Dim oFSO As New FileSystemObject
Dim oFS As TextStream
Dim oFSBU As TextStream
Dim filePath As String
Dim filePathBU As String
Dim szamid As Integer
Dim My_filenumber As Integer
filePath = "C:\Casenumber.txt"
filePathBU = "C:\CasenumberBU.txt"
If Not fileExist(filePath) Then GoTo FileDoesntExist
On Error GoTo Err
Set oFS = oFSO.OpenTextFile(filePath, ForReading)
szamid = oFS.Read(7)
szamid = szamid + 1
szamid = CStr(szamid)
oFS.Close
Set oFS = oFSO.OpenTextFile(filePath, ForWriting)
oFS.WriteLine (szamid)
oFS.Close
Set oFSBU = oFSO.OpenTextFile(filePathBU, ForWriting)
oFSBU.WriteLine (szamid)
oFSBU.Close
MsgBox szamid
Exit Sub
FileDoesntExist:
Set oFSBU = oFSO.OpenTextFile(filePathBU, ForReading)
szamid = oFSBU.Read(7)
szamid = szamid + 1
szamid = CStr(szamid)
oFSBU.Close
Const FILENAME = "C:\Casenumber.txt"
My_filenumber = FreeFile
Open FILENAME For Output As #My_filenumber
Close #My_filenumber
Set oFS = oFSO.OpenTextFile(filePath, ForWriting)
oFS.WriteLine (szamid)
oFS.Close
Set oFSBU = oFSO.OpenTextFile(filePathBU, ForWriting)
oFSBU.WriteLine (szamid)
oFSBU.Close
MsgBox szamid
Exit Sub
Err:
MsgBox "Error while reading the file.", vbCritical, vbNullString
oFS.Close
Exit Sub
End Sub

reading all existing e-mails will use some time and resources.
I would keep a text file on the hard-disk, in which you only store the highest value; when reading it and adding +1 for the next mail, also put the new number into your text file.
How-to: see my answer here: read value from text file, Forward email
Max

Related

VBA - Unable to map drive to sharepoint on another computer

I'm mapping to the company's sharepoint drive using VBA. The intention is to save local file to sharepoint, and delete local file and unmapped the drive after success.
On my machine(Windows 10 64bits), the code works perfectly fine, successfully mapped the drive, created folder and file, successfully uploaded to sharepoint and unmap the drive.
However, when I run the same excel workbook that contains the same code on my colleague's computer(Window 7), it failed. There's no error being shown, except that it keeps on loading and loading until Excel Not Responsive. I tried manually mapping the drive, it success.
I tried to debug and found out that the code stops (keeps on loading) at MsgBox "Hello" but could not figure out what's missing.
Both are using Excel 2016
Any help and suggestions are appreciated. let me know if more info is needed. Thanks in advance.
This is my vba code
Sub imgClicked()
Dim fileName As String
Dim SharePointLib As String
Dim MyPath As String
Dim folderPath As String
Dim objNet As Object
Dim copyPath As String
Dim copyFilePath As String
folderPath = Application.ThisWorkbook.path
MyPath = Application.ThisWorkbook.FullName
Dim objFSO As Object
Dim strMappedDriveLetter As String
Dim strPath As String
Dim spPath As String
strPath = "https://company.com/sites/test/test 123/" 'example path
spPath = AvailableDriveLetter + ":\test.xlsm" 'example path
copyPath = folderPath + "\copyPath\"
'Add reference if missing
Call AddReference
Set objFSO = CreateObject("Scripting.FileSystemObject")
With objFSO
strMappedDriveLetter = IsAlreadyMapped(.GetParentFolderName(strPath))
If Not Len(strMappedDriveLetter) > 0 Then
strMappedDriveLetter = AvailableDriveLetter
If Not MapDrive(strMappedDriveLetter, .GetParentFolderName(strPath)) Then
MsgBox "Failed to map SharePoint directory", vbInformation, "Drive Mapping Failure"
Exit Sub
End If
End If
' Check file/folder path If statement here
End With
Set objFSO = Nothing
End Sub
Code for getting available drive
' Returns the available drive letter starting from Z
Public Function AvailableDriveLetter() As String
' Returns the last available (unmapped) drive letter, working backwards from Z:
Dim objFSO As Object
Dim i As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
For i = Asc("Z") To Asc("A") Step -1
Select Case objFSO.DriveExists(Chr(i))
Case True
Case False
Select Case Chr(i)
Case "C", "D" ' Not actually necessary - .DriveExists should return True anyway...
Case Else
AvailableDriveLetter = Chr(i)
Exit For
End Select
End Select
Next i
Set objFSO = Nothing
MsgBox "This is the next available drive: " + AvailableDriveLetter ' returns Z drive
MsgBox "Hello" ' After this msgBox, starts loading until Not Responsive
End Function
Function to Map drive
Public Function MapDrive(strDriveLetter As String, strDrivePath As String) As Boolean
Dim objNetwork As Object
If Len(IsAlreadyMapped(strDrivePath)) > 0 Then Exit Function
Set objNetwork = CreateObject("WScript.Network")
objNetwork.MapNetworkDrive strDriveLetter & ":", strDrivePath, False
MapDrive = True
MsgBox "Successfully Created the Drive!"
Set objNetwork = Nothing
End Function
Code for MappedDrive
Public Function GetMappedDrives() As Variant
' Returns a 2-D array of (1) drive letters and (2) network paths of all mapped drives on the users machine
Dim objFSO As Object
Dim objDrive As Object
Dim arrMappedDrives() As Variant
Dim i As Long
Set objFSO = CreateObject("Scripting.FileSystemObject")
ReDim arrMappedDrives(1 To 2, 1 To 1)
For i = Asc("A") To Asc("Z")
If objFSO.DriveExists(Chr(i)) Then
Set objDrive = objFSO.GetDrive(Chr(i))
If Not IsEmpty(arrMappedDrives(1, UBound(arrMappedDrives, 2))) Then
ReDim Preserve arrMappedDrives(1 To 2, 1 To UBound(arrMappedDrives, 2) + 1)
End If
arrMappedDrives(1, UBound(arrMappedDrives, 2)) = Chr(i) ' Could also use objDrive.DriveLetter...
arrMappedDrives(2, UBound(arrMappedDrives, 2)) = objDrive.ShareName
End If
Next i
GetMappedDrives = arrMappedDrives
Set objDrive = Nothing
Set objFSO = Nothing
End Function
Public Function IsAlreadyMapped(strPath As String) As String
' Tests if a given network path is already mapped on the users machine
' (Returns corresponding drive letter or ZLS if not found)
Dim strMappedDrives() As Variant
Dim i As Long
strMappedDrives = GetMappedDrives
For i = LBound(strMappedDrives, 2) To UBound(strMappedDrives, 2)
If LCase(strMappedDrives(2, i)) Like LCase(strPath) Then
IsAlreadyMapped = strMappedDrives(1, i)
Exit For
End If
Next i
Set objNetwork = Nothing
End Function
Add Reference
Sub AddReference()
'Macro purpose: To add a reference to the project using the GUID for the
'reference library
Dim strGUID As String, theRef As Variant, i As Long
'Update the GUID you need below.
strGUID = "{420B2830-E718-11CF-893D-00A0C9054228}"
'Set to continue in case of error
On Error Resume Next
'Remove any missing references
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
Set theRef = ThisWorkbook.VBProject.References.Item(i)
If theRef.isbroken = True Then
ThisWorkbook.VBProject.References.Remove theRef
End If
Next i
'Clear any errors so that error trapping for GUID additions can be evaluated
Err.Clear
'Add the reference
ThisWorkbook.VBProject.References.AddFromGuid _
GUID:=strGUID, Major:=1, Minor:=0
'If an error was encountered, inform the user
Select Case Err.Number
Case Is = 32813
'Reference already in use. No action necessary
Case Is = vbNullString
'Reference added without issue
Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
End Select
On Error GoTo 0
End Sub
Procedure imgClicked is calling function AvailableDriveLetter multiple times. Remember that the function has to execute each time you refer to it.
I ran imgClicked (assuming that's the procedure you start with) and I was told, twice, "Next available letter = Z" and "Hello" and then it crashed Excel (perhaps getting stuck in a loop of creating FileSystem objects to look for an available drive letter?)
Try assigning AvailableDriveLetter to a variable (string) at the beginning of the procedure and referring to the variable each time you need the value, and see if you still have the issue.
(Remember to save before execution -- I get frustrated when troubleshooting "application hanging" issues because I keep forgetting to save my changes and then lose them on the crash!)
If this doesn't work, add a breakpoint (F9) on the End Function line after your "Hello" box and see if the code stops there. (I have trouble believing the MsgBox or End Function are the culprit.) If not, which procedure runs after that?
One more thing whether the issue is resolved or not:
Add Option Explicit at the very beginning of your module and then Compile the project and fix your missing variable declaration(s).
This is recommended whenever troubleshooting an issue as a means to eliminate variable declaration issues as a possible cause.

Remove extra line break written with TextStream.WriteLine()

I have following vba code which write items in the ArrayList to file with TextStream.
Sub WriteListAsCSV(list As Object, filePath As String)
Dim fso As New FileSystemObject
Dim ts As TextStream
Set ts = fso.CreateTextFile(filePath, True)
Dim line As Variant
For Each line In list
ts.WriteLine (line)
Next line
ts.Close
End Sub
Problem is I'm getting extra linebreak at the end of the file.
I can do like following but I don't want to check at each loop for that single linebreak.
Sub WriteListAsCSV(list As Object, filePath As String)
Dim fso As New FileSystemObject
Dim ts As TextStream
Set ts = fso.CreateTextFile(filePath, True)
Dim line As Variant
Dim i As Integer
For i = 0 To list.Count
line = list(i)
ts.Write (line)
'If not last line
If Not i = list.Count Then
'Write blankline
ts.WriteLine()
End If
Next
ts.Close
End Sub
Is there any way to remove one character back like Backspace button in VBA? Or another neat trick to do this?
Idea
My idea was to remove the last charaters corresponding to the linebreak, which are Chr(10) or Chr(13) and sometimes both, using the file length.
How to do
While I was checking about how to use a function I found this: Remove last carriage return file which covers exactly my idea ... Maybe have a look it's pretty clear.
EDIT (cf # Siddharth Rout comment)
Modified and commented version of the code (In case of the link dies. I take no credit for this code)
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("path\to\file", 1) ' -- 1:read
strFile = objFile.ReadAll
objFile.Close
' We check if the two last characters correspond to a linebreak:
If Right(strFile, 2) = vbCrLf Then
' If so, we remove those charaters:
strFile = Left(strFile, Len(strFile)- 2)
Set objFile = objFSO.OpenTextFile("path\to\file", 2) ' -- 2:write
objFile.Write strFile
objFile.Close
End If
I'm not sure it's the more elegant way to do but it seems to be a pretty valid one. Hope this works for you.

Read item titles from SharePoint Document Library into Array using Excel VBA

I need to read all the item titles for all the documents in a SharePoint document library directly into an Array using Excel VBA. I can't seem to successfully use FileSystemObject and I do not want to map the document library to a drive letter as the macro will be distributed and widely used.
The SharePoint site has an https address
I have looked at this thread about referencing scrrun.dll but it does not work because I cannot change the trust settings on my local domain
This thread looked promising, but again it seems to use FileSystemObject which might be my hang up.
This thread on the SharePoint stackexchange site works well for reading in a list of files as a worksheet object, but I don't know how it could be adapted to be pushed directly into an array.
I tend to receive Error 76 "Bad Path", but I am easily able to execute on local (C:) files.
I have tried using a WebDAV address - like the answer I gave to this thread - but it too encounters a "Bad Path" error.
There must be a way to read in the contents of a SharePoint document library directly into an array that does not violate my local security policies and doesn't depend upon an excel worksheet.
Ok I am going to self answer. I'm not 100% thrilled with my solution, but it does suffice within my constraints. Here are the high level points:
Use VBA to create BAT files that have the "Net Use" command within them.
Reference the WebDAV address of the document library and find an available drive letter
I doubt that any of my users already have 26 mapped drives...).
Once the document library is mapped it can be iterated through using FileSystemObject commands and the item titles can be loaded into a two dimensional array.
The code will have to be modified to allow for 3 the listing of subfolders
The location of the file count in the ListMyFiles sub would have to be changed or another dimension would have to be added to the array.
Here is the code - I will try to credit all Stack solutions that were integrated into this answer:
Private Sub List_Files()
Const MY_FILENAME = "C:\BAT.BAT"
Const MY_FILENAME2 = "C:\DELETE.BAT"
Dim i As Integer
Dim FileNumber As Integer
Dim FileNumber2 As Integer
Dim retVal As Variant
Dim DriveLetter As String
Dim TitleArray()
FileNumber = FreeFile
'create batch file
For i = Asc("Z") To Asc("A") Step -1
DriveLetter = Chr(i)
If Not oFSO.DriveExists(DriveLetter) Then
Open MY_FILENAME For Output As #FileNumber
'Use CHR(34) to add escape quotes to the command prompt line
Print #FileNumber, "net use " & DriveLetter & ": " & Chr(34) & "\\sharepoint.site.com#SSL\DavWWWRoot\cybertron\HR\test\the_lab\Shared Documents" & Chr(34) & " > H:\Log.txt"
Close #FileNumber
Exit For
End If
Next i
'run batch file
retVal = Shell(MY_FILENAME, vbNormalFocus)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
'This area can be used to evaluate return values from the bat file
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'This calls a function that will return the array of item titles and other metadata
ListMyFiles DriveLetter & ":\", False, TitleArray()
'Create code here to work with the data contained in TitleArray()
'Now remove the network drive and delete the bat files
FileNumber2 = FreeFile
Open MY_FILENAME2 For Output As #FileNumber2
Print #FileNumber2, "net use " & DriveLetter & ": /delete > H:\Log2.txt"
Close #FileNumber2
retVal = Shell(MY_FILENAME2, vbNormalFocus)
'Delete batch file
Kill MY_FILENAME
Kill MY_FILENAME2
End Sub
Here is the function that will read through the directory and return the array of file information:
Sub ListMyFiles(mySourcePath As String, IncludeSubFolders As Boolean, TitleArray())
Dim MyObject As Object
Dim mySource As Object
Dim myFile As File
Dim mySubFolder As folder
Dim FileCount As Integer
Dim CurrentFile As Integer
'Dim TitleArray()
Dim PropertyCount As Integer
CurrentFile = 0
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
FileCount = mySource.Files.Count
ReDim TitleArray(0 To FileCount - 1, 4)
'On Error Resume Next
For Each myFile In mySource.Files
PropertyCount = 1
TitleArray(CurrentFile, PropertyCount) = myFile.Path
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.Name
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.Size
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.DateLastModified
CurrentFile = CurrentFile + 1
Next
'The current status of this code does not support subfolders.
'An additional dimension or a different counting method would have to be used
If IncludeSubFolders = True Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True, TitleArray())
Next
End If
End Sub
Thank you to Chris Hayes for his answer to find empty network drives; thank you to Kenneth Hobson on ozgrid for his expanded answer on listing files in a directory. The rest of the code is ancient and I dredged it out of a folder I last touched in 2010.

using Application.FileDialog to rename a file in VBA

Using VBA. My script moves a file into a directory. If that filename already exists in the target directory, I want the user to be prompted to rename the source file (the one that's being moved) before the move is executed.
Because I want the user to know what other files are in the directory already (so they don't choose the name of another file that's already there), my idea is to open a FileDialog box listing the contents of the directory, so that the user can use the FileDialog box's native renaming capability. Then I'll loop that FileDialog until the source file and target file names are no longer the same.
Here's some sample code:
Sub testMoveFile()
Dim fso As FileSystemObject
Dim file1 As File
Dim file2 As File
Dim dialog As FileDialog
Set fso = New FileSystemObject
fso.CreateFolder "c:\dir1"
fso.CreateFolder "c:\dir2"
fso.CreateTextFile "c:\dir1\test.txt"
fso.CreateTextFile "c:\dir2\test.txt"
Set file1 = fso.GetFile("c:\dir1\test.txt")
Set file2 = fso.GetFile("c:\dir2\test.txt")
Set dialog = Application.FileDialog(msoFileDialogOpen)
While file1.Name = file2.Name
dialog.InitialFileName = fso.GetParentFolderName(file2.Path)
If dialog.Show = 0 Then
Exit Sub
End If
Wend
file1.Move "c:\dir2\" & file1.Name
End Sub
But when I rename file2 and click 'OK', I get an error:
Run-time error '53': File not found
and then going into the debugger shows that the value of file2.name is <File not found>.
I'm not sure what's happening here--is the object reference being lost once the file's renamed? Is there an easier way to let the user rename from a dialog that shows all files in the target directory? I'd also like to provide a default new name for the file, but I can't see how I'd do that using this method.
edit: at this point I'm looking into making a UserForm with a listbox that gets populated w/ the relevant filenames, and an input box with a default value for entering the new name. Still not sure how to hold onto the object reference once the file gets renamed, though.
Here's a sample of using Application.FileDialog to return a filename that the user selected. Maybe it will help, as it demonstrates getting the value the user provided.
EDIT: Modified to be a "Save As" dialog instead of "File Open" dialog.
Sub TestFileDialog()
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = "D:\Temp\Testing.txt" ' Set suggested name for user
' This could be your "File2"
If Dlg.Show = -1 Then
Dim s As String
s = Dlg.SelectedItems.Item(1) ` Note that this is for single-selections!
Else
s = "No selection"
End If
MsgBox s
End Sub
Edit two: Based on comments, I cobbled together a sample that appears to do exactly what you want. You'll need to modify the variable assignments, of course, unless you're wanting to copy the same file from "D:\Temp" to "D:\Temp\Backup" over and over. :)
Sub TestFileMove()
Dim fso As FileSystemObject
Dim SourceFolder As String
Dim DestFolder As String
Dim SourceFile As String
Dim DestFile As String
Set fso = New FileSystemObject
SourceFolder = "D:\Temp\"
DestFolder = "D:\Temp\Backup\"
SourceFile = "test.txt"
Set InFile = fso.GetFile(SourceFolder & SourceFile)
DestFile = DestFolder & SourceFile
If fso.FileExists(DestFile) Then
Dim Dlg As FileDialog
Set Dlg = Application.FileDialog(msoFileDialogSaveAs)
Dlg.InitialFileName = DestFile
Do While True
If Dlg.Show = 0 Then
Exit Sub
End If
DestFile = Dlg.Item
If Not fso.FileExists(DestFile) Then
Exit Do
End If
Loop
End If
InFile.Move DestFile
End Sub
Here's some really quick code that I knocked up but basically looks at it from a different angle. You could put a combobox on a userform and get it to list the items as the user types. Not pretty, but it's a start for you to make more robust. I have hardcoded the directory c:\ here, but this could come from a text box
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger,
ByVal Shift As Integer)
Dim varListing() As Variant
Dim strFilename As String
Dim strFilePart As String
Dim intFiles As Integer
ComboBox1.MatchEntry = fmMatchEntryNone
strFilePart = ComboBox1.Value
strFilename = Dir("C:\" & strFilePart & "*.*", vbDirectory)
Do While strFilename <> ""
intFiles = intFiles + 1
ReDim Preserve varListing(1 To intFiles)
varListing(intFiles) = strFilename
strFilename = Dir()
Loop
On Error Resume Next
ComboBox1.List() = varListing
On Error GoTo 0
ComboBox1.DropDown
End Sub
Hope this helps. On error resume next is not the best thing to do but in this example stops it erroring if the variant has no files

Using VBA to get extended file attributes

Trying to use Excel VBA to capture all the file attributes from files on disk, including extended attributes. Was able to get it to loop through the files and capture the basic attributes (that come from the file system):
File Path
File Name
File Size
Date Created
Date Last Accessed
Date Last Modified
File Type
Would also like to capture the extended properties that come from the file itself:
Author
Keywords
Comments
Last Author
Category
Subject
And other properties which are visible when right clicking on the file.
The goal is to create a detailed list of all the files on a file server.
You say loop .. so if you want to do this for a dir instead of the current document;
Dim sFile As Variant
Dim oShell: Set oShell = CreateObject("Shell.Application")
Dim oDir: Set oDir = oShell.Namespace("c:\foo")
For Each sFile In oDir.Items
Debug.Print oDir.GetDetailsOf(sFile, XXX)
Next
Where XXX is an attribute column index, 9 for Author for example.
To list available indexes for your reference you can replace the for loop with;
for i = 0 To 40
debug.? i, oDir.GetDetailsOf(oDir.Items, i)
Next
Quickly for a single file/attribute:
Const PROP_COMPUTER As Long = 56
With CreateObject("Shell.Application").Namespace("C:\HOSTDIRECTORY")
MsgBox .GetDetailsOf(.Items.Item("FILE.NAME"), PROP_COMPUTER)
End With
You can get this with .BuiltInDocmementProperties.
For example:
Public Sub PrintDocumentProperties()
Dim oApp As New Excel.Application
Dim oWB As Workbook
Set oWB = ActiveWorkbook
Dim title As String
title = oWB.BuiltinDocumentProperties("Title")
Dim lastauthor As String
lastauthor = oWB.BuiltinDocumentProperties("Last Author")
Debug.Print title
Debug.Print lastauthor
End Sub
See this page for all the fields you can access with this: http://msdn.microsoft.com/en-us/library/bb220896.aspx
If you're trying to do this outside of the client (i.e. with Excel closed and running code from, say, a .NET program), you need to use DSOFile.dll.
'vb.net
'Extended file stributes
'visual basic .net sample
Dim sFile As Object
Dim oShell = CreateObject("Shell.Application")
Dim oDir = oShell.Namespace("c:\temp")
For i = 0 To 34
TextBox1.Text = TextBox1.Text & oDir.GetDetailsOf(oDir, i) & vbCrLf
For Each sFile In oDir.Items
TextBox1.Text = TextBox1.Text & oDir.GetDetailsOf(sFile, i) & vbCrLf
Next
TextBox1.Text = TextBox1.Text & vbCrLf
Next
I was finally able to get this to work for my needs.
The old voted up code does not run on windows 10 system (at least not mine). The referenced MS library link below provides current examples on how to make this work. My example uses them with late bindings.
https://learn.microsoft.com/en-us/windows/win32/shell/folder-getdetailsof.
The attribute codes were different on my computer and like someone mentioned above most return blank values even if they are not. I used a for loop to cycle through all of them and found out that Title and Subject can still be accessed which is more then enough for my purposes.
Private Sub MySubNamek()
Dim objShell As Object 'Shell
Dim objFolder As Object 'Folder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.NameSpace("E:\MyFolder")
If (Not objFolder Is Nothing) Then
Dim objFolderItem As Object 'FolderItem
Set objFolderItem = objFolder.ParseName("Myfilename.txt")
For i = 0 To 288
szItem = objFolder.GetDetailsOf(objFolderItem, i)
Debug.Print i & " - " & szItem
Next
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
End Sub
Lucky discovery
if objFolderItem is Nothing when you call
objFolder.GetDetailsOf(objFolderItem, i)
the string returned is the name of the property, rather than its (undefined) value
e.g. when i=3 it returns "Date modified"
Doing it for all 288 values of I makes it clear why most cause it to return blank for most filetypes
e.g i=175 is "Horizontal resolution"